rapprochement de 2 fichiers excel

[inna]

Bonjour,

c'est ma première fois ce matin et voici mon pb j'ai 2 fichiers dont les montants devaient être égaux et ce n'est pas le cas. Je dois alors les rapprocher et identifier les clients pour lesquels j'ai des différences. Comment procéder?
ci joint les extraits des 2 fichiers
et merci pour votre aide.
inna

 

[Annette]

Re : rapprochement de 2 fichiers excel

bonjour inna, le forum,

Une éventuelle solution 🙂.

Cordialement

 

[job75]

Re : rapprochement de 2 fichiers excel

Bonjour inna, bienvenue sur XLD, bonjour Annette,

Un rapprochement par VBA avec résultats dans une feuille dédiée :

Dim P1 As Range, P2 As Range, tablo(), d As Object, n& 'mémorise

Private Sub Worksheet_Activate()
Dim F1 As Worksheet, t1, F2 As Worksheet, t2
Set F1 = Feuil1 'CodeName
Set P1 = F1.Range("A3", F1.Range("A" & F1.Rows.Count).End(xlUp)(4))
t1 = P1 'matrice, plus rapide
Set F2 = Feuil2 'CodeName
Set P2 = F2.Range("A3", F2.Range("A" & F2.Rows.Count).End(xlUp)(4))
t2 = P2 'matrice, plus rapide
ReDim tablo(1 To UBound(t1) + UBound(t2), 1 To 3)
Set d = CreateObject("Scripting.dictionary")
n = 0
Remplissage t1
Remplissage t2
'---restitution---
If n Then
  [A2].Resize(n, 3) = tablo
  [A2].Resize(n, 3).Sort [A2], xlAscending, Header:=xlNo 'tri
End If
Range("A" & n + 2 & ":C" & Rows.Count).ClearContents
End Sub

Sub Remplissage(tb)
Dim t, m1#, m2#
For Each t In tb
  If Not d.exists(t) Then
    d(t) = ""
    m1 = Application.SumIf(P1, t, P1.Offset(, 1))
    m2 = Application.SumIf(P2, t, P2.Offset(, 1))
    If m1 <> m2 Then
      n = n + 1
      tablo(n, 1) = t
      tablo(n, 2) = m1 'IIf(m1, m1, "n/a")
      tablo(n, 3) = m2 'IIf(m2, m2, "n/a")
    End If
  End If
Next
End Sub

Fichier joint.

A+

 

[job75]

Re : rapprochement de 2 fichiers excel

Message annulé.

Bonne nuit et A+

 

[job75]

Re : rapprochement de 2 fichiers excel

Bonjour inna, Annette, le forum,

Si l'on veut rapprocher chaque montant c'est plus compliqué.

Voyez ce code dans la feuille "Montants non rapprochés" :

Dim tablo() 'mémorise

Private Sub Worksheet_Activate()
Dim F1 As Worksheet, F2 As Worksheet, lig&, t1, t2, n&
Set F1 = Feuil1 'CodeName
Set F2 = Feuil2 'CodeName
lig = 3 '1ère ligne étudiée
t1 = F1.Cells(lig, 1).Resize(F1.Cells(F1.Rows.Count, 1).End(xlUp).Row, 2)
t2 = F2.Cells(lig, 1).Resize(F2.Cells(F2.Rows.Count, 1).End(xlUp).Row, 2)
n = UBound(t1) + UBound(t2)
ReDim tablo(1 To n, 1 To 5)
Remplissage t1, t2, 0, UBound(t1), lig, 3
Remplissage t2, t1, UBound(t1), 0, lig, 4
'---restitution---
[A2].Resize(n, 4) = tablo
[A2].Resize(n, 4).Sort [A2], xlAscending, Header:=xlNo 'tri indispensable
Range("A" & n + 2 & ":D" & Rows.Count).ClearContents
n = Me.UsedRange.Rows.Count 'ajustement de la barre de défilement verticale
End Sub

Sub Remplissage(t1, t2, decal1&, decal2&, lig&, col As Byte)
Dim fin&, i&, x$, j&
fin = UBound(t2)
For i = 1 To UBound(t1)
  If IsEmpty(tablo(i + decal1, 5)) Then
    x = t1(i, 1) & Chr(1) & t1(i, 2)
    For j = 1 To fin
      If IsEmpty(tablo(j + decal2, 5)) Then
        If x = t2(j, 1) & Chr(1) & t2(j, 2) Then
          tablo(i + decal1, 5) = 1
          tablo(j + decal2, 5) = 1
          GoTo 1
        End If
      End If
    Next
    tablo(i + decal1, 1) = t1(i, 1)
    tablo(i + decal1, 2) = t1(i, 2)
    tablo(i + decal1, col) = lig + i - 1
  End If
1 Next
End Sub

Fichier (2).

A+

 

[job75]

Re : rapprochement de 2 fichiers excel

Re,

Pour peaufiner on peut ajouter un double-clic pour atteindre les montants non rapprochés :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Or Target.Row > Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
Cancel = True
With Cells(Target.Row, 3)
  If .Value Then
    Application.Goto Feuil1.Cells(.Value, 1), True
  Else
    Application.Goto Feuil2.Cells(.Offset(, 1), 1), True
  End If
End With
End Sub

Fichier (3).

A+