Last active
July 4, 2023 16:01
-
-
Save developpeur-pro/cda9795ed80617929d1f837a081acec1 to your computer and use it in GitHub Desktop.
Comparaison de 2 tableaux Excel et création d'un 3ème tableau contenant les différences ou les éléments communs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Option Base 1 | |
Public Enum ComparisonMode | |
xDifferences = 1 | |
xMatches = 2 | |
End Enum | |
Public Sub ComparerTableaux() | |
' Modifiez le code ci-dessous pour l'adapter à vos besoins : | |
' - noms des feuilles contenant les tableaux (Feuil1, Feuil2) | |
' - noms des tableaux (TableauA, TableauB) | |
' - numéros de la première et de la dernière colonne de la plage de colonnes à comparer (1, 3) | |
' (Pour comparer selon une seule colonne, mettez 2 numéros identiques) | |
' - xDifferences pour extraire les différences ou xMatches pour extraire les éléments communs | |
BuildComparisonResult Worksheets("Feuil1").ListObjects("TableauA"), _ | |
Worksheets("Feuil2").ListObjects("TableauB"), 1, 3, _ | |
xDifferences, ActiveCell | |
End Sub | |
' La première cellule de ce tableau est la cellule active de la feuille | |
' Paramètres : | |
' - les objets tableaux et les N° de colonnes à comparer, | |
' - le mode de comparaison (différences ou similitudes) | |
' - la cellules à partir de laquelle créer le tableau de résultat | |
Public Sub BuildComparisonResult(list1 As ListObject, list2 As ListObject, _ | |
colIndex1 As Integer, colIndex2 As Integer, _ | |
compMode As ComparisonMode, rgInit As Range) | |
If colIndex1 > colIndex2 Or colIndex1 > list1.ListColumns.Count Or colIndex1 > list2.ListColumns.Count Or _ | |
colIndex2 > list1.ListColumns.Count Or colIndex2 > list2.ListColumns.Count Then | |
MsgBox "Vous devez spécifier des N° de colonnes inférieurs ou égaux aux nombres de colonnes de chacun des tableaux." & vbCrLf & vbCrLf & _ | |
"Le premier N° doit être inférieur ou égal au second.", vbCritical, "Erreur sur les N° de colonnes" | |
Exit Sub | |
End If | |
' On compare les tableaux en prenant le premier comme référence | |
Dim coll1 As Collection | |
Set coll1 = CompareListObjects(list1, list2, colIndex1, colIndex2, compMode) | |
' Si on cherche les différences, il faut aussi comparer dans l'autre sens | |
' c'est à dire en prenant le second tableau comme référence | |
If compMode = xDifferences Then | |
Dim coll2 As Collection | |
Set coll2 = CompareListObjects(list2, list1, colIndex1, colIndex2, compMode) | |
End If | |
' S'il n'y a aucun résultat à afficher, on affiche un message et on ne va pas plus loin | |
If compMode = xMatches Then | |
If coll1.Count = 0 Then | |
MsgBox "Il n'y a aucune valeur commune aux 2 tableaux", vbInformation | |
Exit Sub | |
End If | |
Else | |
If coll1.Count = 0 And coll2.Count = 0 Then | |
MsgBox "Les 2 tableaux sont identiques", vbInformation | |
Exit Sub | |
End If | |
End If | |
' En-têtes du tableau de résultat | |
Dim c As Long | |
For c = 1 To colIndex2 - colIndex1 + 1 | |
rgInit.Offset(0, c - 1).Value2 = list1.HeaderRowRange(1, c + colIndex1 - 1).Value2 | |
Next | |
' Lignes de résultats de la première comparaison | |
Dim i As Long | |
For i = 1 To coll1.Count | |
For c = colIndex1 To colIndex2 | |
rgInit.Offset(i, c - colIndex1).Value2 = coll1(i)(c) | |
Next c | |
Next i | |
' Si on cherche les différences, on ajoute les résultats de la seconde comparaison | |
If compMode = xDifferences Then | |
rgInit.Offset(0, colIndex2 - colIndex1 + 1).Value2 = "Tableau" ' en-tête de la colonne Tableau | |
' Valeur de la colonne Tableau pour toutes les lignes issues de la première comparaison | |
If coll1.Count > 0 Then rgInit.Offset(1, colIndex2 - colIndex1 + 1).Resize(coll1.Count, 1).Value2 = 1 | |
' Résultats de la seonde comparaison | |
For i = 1 To coll2.Count | |
For c = colIndex1 To colIndex2 | |
rgInit.Offset(coll1.Count + i, c - colIndex1).Value2 = coll2(i)(c) | |
Next c | |
Next i | |
' Valeur de la colonne Tableau pour toutes les lignes issues de la seconde comparaison | |
If coll2.Count > 0 Then | |
rgInit.Offset(coll1.Count + 1, colIndex2 - colIndex1 + 1).Resize(coll2.Count, 1).Value2 = 2 | |
End If | |
End If | |
' On crée un objet tableau à partir des résultats générés précédemment | |
' et on le trie selon la première colonne | |
Dim lstObj As ListObject | |
Set lstObj = ActiveSheet.ListObjects.Add(xlSrcRange, rgInit.CurrentRegion, , xlYes) | |
With lstObj | |
.TableStyle = "TableStyleLight14" | |
.ShowTotals = True | |
.ListColumns(1).TotalsCalculation = xlTotalsCalculationCount | |
If .ListColumns.Count > 1 Then | |
.ListColumns(.ListColumns.Count).TotalsCalculation = xlTotalsCalculationNone | |
End If | |
If Not .ListColumns(1).DataBodyRange Is Nothing Then | |
.Sort.SortFields.Add2 Key:=.ListColumns(1).DataBodyRange | |
.Sort.Apply | |
End If | |
End With | |
' Ajoute un titre au-dessus du tableau | |
'rgInit.Offset(-1, 0).Value2 = IIf(compMode = xMatches, "Valeurs communes", "Différences") | |
End Sub | |
' Compare 2 tableaux selon une plage de colonnes délimitée par 2 indices | |
' Le 1er tableau est la référence | |
' La fonction renvoie le résultat sous forme d'une collection contenant : | |
' - Si compType = xDifferences : les éléments présents dans le premier tableau et pas dans le second | |
' - Si compType = xMatches : les éléments présents dans les 2 tableaux | |
Private Function CompareListObjects(list1 As ListObject, list2 As ListObject, _ | |
colIndex1 As Integer, colIndex2 As Integer, compMode As ComparisonMode) | |
Dim ar1() ' Pour stocker les elts du premier tableau à comparer | |
Dim ar2() ' Pour stocker les elts du second tableau à comparer | |
' On récupère les valeurs des tableaux à comparer | |
ar1 = list1.DataBodyRange.Value2 | |
ar2 = list2.DataBodyRange.Value2 | |
Dim matches As New Collection ' Pour stocker les elts qui correspondent | |
Dim differences As New Collection ' Pour stocker les elts sans correpondance | |
Dim i As Long | |
Dim j As Long | |
Dim k As Long | |
Dim matchRow As Boolean | |
Dim matchCol As Boolean | |
For i = 1 To UBound(ar1, 1) | |
matchRow = False | |
For j = 1 To UBound(ar2, 1) | |
matchCol = True | |
For k = colIndex1 To colIndex2 | |
If ar1(i, k) <> ar2(j, k) Then | |
matchCol = False | |
Exit For | |
End If | |
Next k | |
' Si les valeurs de toutes les colonnes sont identiques, | |
' on ajoute la ligne à la liste des lignes qui correspondent | |
If matchCol Then | |
matchRow = True | |
matches.Add Application.WorksheetFunction.Index(ar1, i, 0) | |
Exit For | |
End If | |
Next j | |
If Not matchRow Then | |
differences.Add Application.WorksheetFunction.Index(ar1, i, 0) | |
End If | |
Next i | |
If compMode = xDifferences Then | |
Set CompareListObjects = differences | |
Else | |
Set CompareListObjects = matches | |
End If | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Cette 3ème version prend en charge la comparaison selon plusieurs colonnes adjacentes.