Discussion :

[Carhiboux]

Bonjour à tous,

Je viens solliciter vos lumière pour un petit problème dont je ne vois pas la solution.

En entrée, j'ai deux tableaux. Qui ont le même nombre de colonnes. Pas forcément le même nombre de lignes.

Il y a des différences entre les deux tableaux. Pas beaucoup, mais le tableau est suffisamment gros pour ne pas avoir envie de faire le travail manuel à chaque fois!

Je voudrais générer, à l'aide de formule ou macro, un différentiel de ces deux listes, tel que présenté dans le document exemple en PJ.

Existe-t-il une formule excel qui permettre de comparer plusieurs champs en même temps?

D'avance merci pour toutes les pistes que vous pourrez me donner!

[casefayere]

Bonjour,
Il ne sert à rien de mettre un fichier en Pj, d'autant qu'il n'explique rien. Pour ma part, je n'ai pas compris ta demande

[Carhiboux]

Je vais donc m’efforcer d'être plus clair.

J'ai deux sources de données. A partir desquelles j'obtiens des jolis tableaux.

Ces deux sources sont supposées êtres identiques. Evidement, et sinon ma question n'aurait aucun intérêt, les deux sources ont été modifiées chacune de leur coté.

Je me retrouve donc avec des différences entre mes deux tableaux issus chacun d'une source de donnée.

Exemple :
Tableau 1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Ligne1         Arg1 
Ligne2         Arg2
Ligne3         Arg3

et

Tableau 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Ligne1         Arg1
Ligne2         Arg5
Ligne4         Arg4

Je souhaite donc pouvoir comparer les deux tableaux pour créer un troisième tableau qui ne contient que les lignes qui ne sont pas identiques dans le tableau 1 et le tableau 2 selon trois critères :

1) Le premier champ est identique (exemple de Ligne2) mais les autres valeurs de la lignes sont différentes (Arg2 != Arg5).

2) Le premier champ de tableau1 est absent de tableau2 (exemple de Ligne3)

3) Le premier champ de tableau2 est absent de tableau1 (exemple de Ligne4)

Tableau résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Ligne2      Arg2       Ligne2      Arg5            <= valeurs différentes entre les deux tableaux
Ligne3      Arg3                                   <= ligne présente dans un seul tableau
                       Ligne4      Arg4            <= ligne présente dans un seul tableau.

Pour le moment, avec SI(ESTERREUR(RECHERCHEV())), j'arrive à obtenir les lignes qui sont différentes. Mais j'ai aussi tout plein de lignes vides... ce qui n'est pas très lisible comme résultat.

j'espère avoir été plus clair.

[casefayere]

Bonsoir,

Peux-tu essayer (si j'ai compris) ce code en l'adaptant, j'ai estimé que tes sources de données sont sur des classeurs différents (et ouverts, bien sur)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub essai()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Wresult As Worksheet
Dim dl As Long, x As Long, y As Long, i As Long
Dim Tb1, Tb2, Tbresult()
Set Ws1 = Workbooks("base1.xlsm").Sheets("Feuil1") 'à adapter
Set Ws2 = Workbooks("base2.xlsm").Sheets("Feuil1") 'à adapter
Set Wresult = Workbooks("resultat.xlsm").Sheets("Feuil1") 'à adapter
With Ws1
  dl = .Range("A" & .Rows.Count).End(xlUp).Row 'si les données sont en A et B
  Tb1 = .Range("A2:B" & dl)
End With
With Ws2
  dl = .Range("A" & .Rows.Count).End(xlUp).Row 'si les données sont en A et B
  Tb2 = .Range("A2:B" & dl)
End With
i = 0
ReDim Preserve Tbresult(1 To UBound(Tb1, 1) + UBound(Tb2, 1), 1 To 4)
dl = WorksheetFunction.Min(UBound(Tb1, 1), UBound(Tb2, 1))
For x = 1 To WorksheetFunction.Max(UBound(Tb1, 1), UBound(Tb2, 1))
  If dl >= x Then
    If Tb1(x, 1) = Tb2(x, 1) And Tb1(x, 2) <> Tb2(x, 2) Then
      i = i + 1
      Tbresult(i, 1) = Tb1(x, 1)
      Tbresult(i, 2) = Tb1(x, 2)
      Tbresult(i, 3) = Tb2(x, 1)
      Tbresult(i, 4) = Tb2(x, 2)
    ElseIf Tb1(x, 1) <> Tb2(x, 1) Then
      i = i + 1
      Tbresult(i, 1) = Tb1(x, 1)
      Tbresult(i, 2) = Tb1(x, 2)
      i = i + 1
      Tbresult(i, 3) = Tb2(x, 1)
      Tbresult(i, 4) = Tb2(x, 2)
    End If
  ElseIf x < UBound(Tb1, 1) Then
    i = i + 1
    Tbresult(i, 1) = Tb1(x, 1)
    Tbresult(i, 2) = Tb1(x, 2)
  ElseIf x < UBound(Tb2, 1) Then
    i = i + 1
    Tbresult(i, 3) = Tb2(x, 1)
    Tbresult(i, 4) = Tb2(x, 2)
  End If
Next x
Wresult.UsedRange.ClearContents
Wresult.Range("A2:D" & UBound(Tbresult, 1) + 1) = Tbresult
End Sub

[Carhiboux]

Super!

Cela correspond en effet à peu près à ce que je souhaite faire. Quelques adaptations mineures à faire, mais je touche au but!

Un grand merci, je n'en espérais pas tant!

[Marc-L]

Bonjour,

j'avais commencé à étudier la demande mais n'avais rien publié en attendant des précisions …

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub DiffListes(ByVal Liste1 As Range, ByVal Liste2 As Range, ByVal Destination As Range)
    If Liste1.Count = 1 Then Set Liste1 = Liste1.CurrentRegion
    If Liste2.Count = 1 Then Set Liste2 = Liste2.CurrentRegion
    CC& = Liste1.Columns.Count:  RC& = Liste1.Rows.Count
 
    If Liste2.Columns.Count = CC And Liste2.Rows.Count = RC And RC > 1 Then
        Dim TL(1 To 2):  TL(1) = Liste1.Value:  TL(2) = Liste2.Value
        ReDim AR(1 To CC * 2, 1 To 1)
 
        For L& = 1 To RC
            If TL(1)(L, 1) = TL(2)(L, 1) Then
                E& = 0
                For C& = 2 To CC:  E = E - (TL(1)(L, C) <> TL(2)(L, C)):  Next C
 
                If E Then
                    R& = R& + 1:  E = 0
                    If R > UBound(AR, 2) Then ReDim Preserve AR(1 To CC * 2, 1 To R)
 
                    For T% = 1 To 2
                        For C = 1 To CC:  E = E + 1:  AR(E, R) = TL(T)(L, C):  Next C
                    Next T
                End If
 
            Else
                If R + 2 > UBound(AR, 2) Then ReDim Preserve AR(1 To CC * 2, 1 To R + 2)
 
                For T = 1 To 2
                    R = R + 1:  E = CC * (T - 1)
                    For C = 1 To CC:  AR(C + E, R) = TL(T)(L, C):  Next C
                Next T
            End If
        Next L
 
        If R Then
            If Destination.Count = 1 Then Set Destination = Destination.Resize(R, CC * 2)
            Destination.Value = Application.Transpose(AR)
        End If
 
        Erase AR, TL
    End If
 
    Set Destination = Nothing:  Set Liste1 = Nothing:  Set Liste2 = Nothing
End Sub
 
 
Sub Demo()
    DiffListes [A1], [E1], [J8]
End Sub