Soustraire des valeurs sur une ligne

Bonsoir à tous,

Dans l'optique de réaliser un plan de charge, j'ai extrait des données d'un outil de gestion des imputations, mais le fait est que des données sont "mixées" : en effet, plusieurs typologies de consommations sont possibles : les jours Hommes et les €.

Ici on s'intéresse aux JH, qui peuvent eux-mêmes être de deux formes : les JH affectés, et les JH provisionnés, non nominatifs.

J'aimerais séparer ces deux données, qui sont regroupés dans une même ligne pour chaque projet concerné.

Pour cela, j'aimerais procéder avec l'aide d'une macro, qui a déjà permis de pas mal retratier le fichier source, ce qui donne le fichier en pièce jointe.

J'ai essayé d'impriquer plusieurs boucles, mais j'ai du mal…

Peut-être qu'avec un VLOOKUP comme j'ai fait dans le fichier ? Mais j'ai du mal à l'implémenter en VBA...

Pourriez-vous m'aider svp ? Merci d'avance, et si cela n'est pas clair, n'hésitez pas à me demander !

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonsoir julking92, gmb, le forum

A tester, si j'ai bien compris.

Attention au nom des feuilles.

Option Explicit

Sub macro1()
Dim a, b(), i As Long, j As Long, n As Long, x As Long, w(), y
    a = Sheets(1).Range("B5").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then .Item(a(i, 1)) = Empty
            If IsEmpty(.Item(a(i, 1))) Then
                ReDim w(1 To UBound(a, 2))
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
                .Item(a(i, 1)) = w
            Else
                w = .Item(a(i, 1))
                For j = 3 To UBound(a, 2)
                    w(j) = w(j) - a(i, j)
                Next
                .Item(a(i, 1)) = w
                n = n + 1
                For j = 1 To UBound(a, 2)
                    b(n, j) = a(i, j)
                Next
            End If
        Next
        y = .items: x = .Count
    End With
    'Restitution et mise en forme
    Application.ScreenUpdating = False
    With Sheets(2).Range("A1")
        .CurrentRegion.Clear
        .Resize(, UBound(a, 2)).Value = a
        .Offset(1).Resize(x, UBound(a, 2)).Value = _
        Application.Transpose(Application.Transpose(y))
        If n > 0 Then
            .Offset(x + 1).Resize(n, UBound(b, 2)).Value = b
        End If
        With .CurrentRegion
            .Columns.AutoFit
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Offset(, 2).Resize(, .Columns.Count - 2).NumberFormat = "[$-40C]mmm-yy;@"
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
            End With
            .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2).NumberFormat = "0"
            '.Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89