VBA - recherche de référence et calcul de différence

Bonjour,

Je galère avec un fichier depuis 1 semaine et ne trouve pas un code qui me permettrait de répondre à la problématique ci-dessous.

J'ai un fichier comptable contenant deux tableaux de lettrage. J'aimerai enfaite qu'à partir de VBA je puisse calculer des différences de montant entre mes deux tableaux. Pour être plus clair, la macro irait trouver toutes les lignes qui ont les mêmes références (qui peuvent se trouver dans trois colonnes), et dans une seconde feuille indiquerait la différence de montant qu'il y a entre le total du tableau 1 de cette référence et le total du tableau 2 de cette référence.

J'espère avoir été clair et que quelqu'un pourra m'apporter son aide afin de résoudre ce problème car je galère cruellement depuis quelques jours

Par exemple dans l'exemple ci-dessous, j'aimerai que dans une autre feuille, la macro me permette de visualiser que pour la référence ax22 il y a une différence de 5 entre les deux tableaux.

Bien à vous,

Cordialement.

Bonjour

Essayez ceci, à adapter à vos fichiers.

le code

Sub Delta()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim d1 As Object, d2 As Object
    Dim i As Long, j As Long, DerLig As Long
    Dim c As Range
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("Delta")
    Set Tab1 = f1.Range("D5:E9,K5:K9")
    Set Tab2 = f1.Range("D20:E27,K20:K27")
    f2.Range("A2:H10000").ClearContents

    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    For Each c In Tab1
        If c <> "" Then
            d1(c.Value) = d1(c.Value) + f1.Cells(c.Row, "G")
        End If
    Next

    For Each c In Tab2
        If c <> "" Then
            d2(c.Value) = d2(c.Value) + f1.Cells(c.Row, "G")
        End If
    Next
    If d1.Count > 0 Then
        f2.Range("A1").Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.keys)
        f2.Range("B1").Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.items)
    End If
    If d2.Count > 0 Then
        f2.Range("D1").Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.keys)
        f2.Range("E1").Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.items)
    End If

    'Calcul des différences pour une même référence entre tableaux
    DerLig = d1.Count + 1
    f2.Range("G2:G" & DerLig).FormulaR1C1 = "=IF(RC1="""","""",RC1)"
    f2.Range("H2:H" & DerLig).FormulaR1C1 = "=iferror(IF(RC7="""","""",ABS(RC2-INDEX(C4:C5,MATCH(RC7,C4,0),2))),"""")"

    'Suppression des lignes vides
    For i = DerLig To 2 Step -1
        If f2.Cells(i, "H") = "" Then Range(f2.Cells(i, "G"), f2.Cells(i, "H")).Delete shift:=xlUp
    Next i
    d1.RemoveAll
    d2.RemoveAll
    Set f1 = Nothing
    Set f2 = Nothing
    Set d1 = Nothing
    Set d2 = Nothing
End Sub

Cdlt

Bonjour @arturo83 et merci beaucoup pour votre aide ! C’est effectivement la base de code qu’il me fallait pour ma problématique, je l’adapte donc à mes besoins.

Merci infiniment !

Bien à vous.