comparaison de tableaux excel à 2 dimensions (matrices)

lelfedesboa · 21 Décembre 2011

Bonjour à tous,

J'espère poster au bon endroit 🙂
Voilà mon problème. Je dois faire une comparaison de 2 fichiers excel en vba. jusque là rien de très compliqué.
Ces 2 fichiers représentent une version ancienne et nouvelle de matrices de compatibilité entre des formules et des options.
Chaque fichier est constitué d'intitulés classés par ordre alphabétique sur la colonne A et sur la ligne 1.
A chaque nouvelle version, il peut y avoir des lignes et/ou des colonnes en + ou en -.
A l'intersection de chaque ligne/colonne, se trouve (ou pas) uniquement des X indiquant la compatibilité (ou non) des formules/options.
Je veux générer un fichier final dans lequel seraient contenues les différences rencontrées lors de l'analyse des fichiers, et (si possible) inserer des colonnes vides dans mon nouveau fichier à l'endroit ou certaines auront été supprimées afin que mes croix coincident avec les colonnes d'origine.
Je sais pas si je suis assez claire sur mon problème, mais j'avoue que je ne sais pas trop par ou m'y prendre pour comparer tout ça.
Je poste ici pour faire un brainstorming, et éveiller quelques idées pour commencer 😉
merci d'avance pour vos réponses !

job75 · 21 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

Bonjour lelfedesboa, bienvenue sur XLD,

lelfedesboa à dit:
Je dois faire une comparaison de 2 fichiers excel en vba. jusque là rien de très compliqué.

Cela peut être compliqué, ça dépend de ce que vous voulez finalement comparer.

Vous ne précisez pas grand'chose. Par exemple que fait-on des X ??

lelfedesboa à dit:
Je poste ici pour faire un brainstorming, et éveiller quelques idées pour commencer 😉

Bonne idée, mais sans fichier(s) à se mettre sous la dent seules nos boules de cristal cogitent.

Et ces garces sont des fainéantes.

A+

Staple1600 · 21 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

Bonsoir

Même constat que job75.

Sinon, si j'étais toi (et pour le fun), j'irai dans la "boite noire" et je saisirai ceci : fc /?

Cela fonctionne peut être sur des fichiers Excel.

A voir 😉

lelfedesboa · 21 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

Je vous met un fichier exemple demain. Merci de vos premières réponse ;-)

Staple1600 · 21 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

Re

Tu as essayé :fc /?

(La boite noire= Invite MSDos)

lelfedesboa · 22 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

FC ne compare que les lignes ? j'ai besoin de comparer aussi les colonnes... 🙁
Je joins un fichier "exemple", sachant que les colonnes et les lignes des intitulés sont toujours classées par ordre alpha, et que dans les versions suivantes des lignes/colonnes ont pu être ajoutées/supprimées

lelfedesboa · 22 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

job75 à dit:
Vous ne précisez pas grand'chose. Par exemple que fait-on des X ??

Les x m'indiquent si les formules/options sont compatibles entre elles, j'ai donc besoin de les conserver, et de respecter leur place initiale(intitulé de ligne et de colonne identique au fichier origine) en cas de création de nouvelle ligne ou colonne

lelfedesboa · 22 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

l'exemple donné est assez parlant ?

job75 · 22 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

Bonsoir,

lelfedesboa à dit:
l'exemple donné est assez parlant ?

Il correspond à ce qu'on avait compris.

Mais il faudrait aussi le 2ème fichier (différent), et surtout le fichier final permettant de comprendre la comparaison que vous voulez faire.

Dans ce fichier final, il est très facile d'inscrire les formules et les options du 1er et du 2ème fichier.

Mais encore une fois que faire des X ?

Si on les inscrit dans leurs colonnes et lignes respectives, on ne saura pas s'ils proviennent du 1er ou du 2ème fichier [Edit] ou des deux...

PS : je pars en vacances et ne reviendrai sur le fil que bien après le 1er janvier.

A+

lelfedesboa · 23 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions

job75 à dit:
Mais il faudrait aussi le 2ème fichier (différent), et surtout le fichier final permettant de comprendre la comparaison que vous voulez faire.

Dans ce fichier final, il est très facile d'inscrire les formules et les options du 1er et du 2ème fichier.

Mais encore une fois que faire des X ?

Si on les inscrit dans leurs colonnes et lignes respectives, on ne saura pas s'ils proviennent du 1er ou du 2ème fichier [Edit] ou des deux...

Je joins une archive contenant les 3 fichiers. Ancien et nouveau pour les 2 fichiers à comparer, final pour ce que je veux obtenir.
Donc je veux mettre en évidence les choses nouvelles (en vert) apparues sur le fichier "nouveau", et surtout vérifier si pour les choses déjà existantes(fichier "ancien") il n'y a pas eu de modification (croix manquante par exemple)=>en rouge.
Les X devraient être les mêmes entre les 2 fichiers sur les choses existantes (en prenant en compte les colonnes/lignes ajoutées, càd qu'ils doivent être décalés en fonction de choses insérées entre les 2 versions), c'est pour ça que s'il y a une différence je veux la faire ressortir.
J'espère encore une fois être assez claire...
Je tiens à préciser que normalement le codage de la macro ne pose pas de souci, c'est vraiment un problème d'algo, je ne sais pas par ou commencer pour comparer tout ça...
Merci d'avance pour vos réponses, et bonnes fêtes de fin d'année !

job75 · 31 Décembre 2011

Re : comparaison de tableaux excel à 2 dimensions (matrices)

Bonjour lelfedesboa, le forum,

Merci pour les 3 fichiers.

La macro suivante - dans le fichier final(1) - détermine d'abord les en-têtes de lignes et colonnes (sans doublon) qui se trouvent dans les 2 fichiers ancien et nouveau.

Si une en-tête a été supprimée ou ajoutée, elle est colorée, comme les autres cellules, en rouge ou en vert :

Code:

Sub Comparer()
Dim F1 As Worksheet, F2 As Worksheet
Dim col1 As Variant, col2 As Variant, lig1 As Variant, lig2 As Variant
Dim dercol%, i&, j%, form$, opt$, v1$, v2$
Application.ScreenUpdating = False
'---initialisation---
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
On Error Resume Next
Set F1 = Workbooks("ancien.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'ancien.xls' !": Exit Sub
Set F2 = Workbooks("nouveau.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'nouveau.xls' !": Exit Sub
On Error GoTo 0
'---options classées sans doublon---
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col2 = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
Cells(1, 1).Resize(, col1) = F1.Cells(1, 1).Resize(, col1).Value
Cells(1, col1 + 1).Resize(, col2) = F2.Cells(1, 1).Resize(, col2).Value
Cells(1, 2).Resize(, col1 + col2 - 1).Sort [B1], Header:=xlNo, Orientation:=xlLeftToRight
For i = col1 + col2 To 2 Step -1 'suppression des doublons
If Cells(1, i) = Cells(1, i - 1) Then Cells(1, i).Delete xlToLeft
Next
'---formules classées sans doublon---
lig1 = F1.Cells(F1.Rows.Count, 1).End(xlUp).Row
lig2 = F2.Cells(F2.Rows.Count, 1).End(xlUp).Row
Cells(1, 1).Resize(lig1) = F1.Cells(1, 1).Resize(lig1).Value
Cells(lig1 + 1, 1).Resize(lig2) = F2.Cells(1, 1).Resize(lig2).Value
Cells(2, 1).Resize(lig1 + lig2 - 1).Sort [A2], Header:=xlNo, Orientation:=xlTopToBottom
For i = lig1 + lig2 To 2 Step -1 'suppression des doublons
If Cells(i, 1) = Cells(i - 1, 1) Then Cells(i, 1).Delete xlUp
Next
'---remplissage et couleurs---
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
  form = Cells(i, 1)
  lig1 = IIf(i = 1, 1, Application.Match(form, F1.[A:A], 0))
  lig2 = IIf(i = 1, 1, Application.Match(form, F2.[A:A], 0))
  For j = 1 To dercol
    opt = Cells(1, j)
    col1 = IIf(j = 1, 1, Application.Match(opt, F1.[1:1], 0))
    col2 = IIf(j = 1, 1, Application.Match(opt, F2.[1:1], 0))
    v1 = "": v2 = ""
    If IsNumeric(lig1) And IsNumeric(col1) Then v1 = F1.Cells(lig1, col1)
    If IsNumeric(lig2) And IsNumeric(col2) Then v2 = F2.Cells(lig2, col2)
    If v2 <> "" Then Cells(i, j) = v2 'valeurs du fichier nouveau.xls
    If v1 <> "" And v2 = "" Then Cells(i, j).Interior.ColorIndex = 3 'rouge
    If v1 = "" And v2 <> "" Then Cells(i, j).Interior.ColorIndex = 4 'vert
  Next
Next
End Sub

Ci-joint les 3 fichiers.

A tous je souhaite un joyeux réveillon et une excellente année 2012.

A+

job75 · 1 Janvier 2012

Re : comparaison de tableaux excel à 2 dimensions (matrices)

Bonjour lelfedesboa, le forum,

Sur un grand tableau cette version (2) est plus rapide :

- utilisation de l'objet Scripting.Dictionary pour obtenir les en-têtes sans doublon

- remplissage et coloration des cellules mémorisées en bloc.

Code:

Sub Comparer()
Dim F1 As Worksheet, F2 As Worksheet, d As Object
Dim col1 As Variant, col2 As Variant, lig1 As Variant, lig2 As Variant
Dim dercol%, i&, j%, form$, opt$, v1$, v2$, X As Range, rouge As Range, vert As Range
Application.ScreenUpdating = False
'---initialisation---
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
On Error Resume Next
Set F1 = Workbooks("ancien.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'ancien.xls' !": Exit Sub
Set F2 = Workbooks("nouveau.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'nouveau.xls' !": Exit Sub
On Error GoTo 0
'---options classées sans doublon---
Set d = CreateObject("Scripting.Dictionary")
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col2 = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
For i = 1 To col1
d(F1.Cells(1, i).Value) = F1.Cells(1, i).Value
Next
For i = 1 To col2
d(F2.Cells(1, i).Value) = F2.Cells(1, i).Value
Next
Cells(1, 1).Resize(, d.Count) = d.keys
Cells(1, 2).Resize(, col1 + col2 - 1).Sort [B1], Header:=xlNo, Orientation:=xlLeftToRight
'---formules classées sans doublon---
Set d = CreateObject("Scripting.Dictionary")
lig1 = F1.Cells(F1.Rows.Count, 1).End(xlUp).Row
lig2 = F2.Cells(F2.Rows.Count, 1).End(xlUp).Row
For i = 1 To lig1
d(F1.Cells(i, 1).Value) = F1.Cells(i, 1).Value
Next
For i = 1 To lig2
d(F2.Cells(i, 1).Value) = F2.Cells(i, 1).Value
Next
Cells(1, 1).Resize(d.Count) = Application.Transpose(d.keys)
Cells(2, 1).Resize(lig1 + lig2 - 1).Sort [A2], Header:=xlNo, Orientation:=xlTopToBottom
'---remplissage et couleurs---
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
  form = Cells(i, 1)
  lig1 = IIf(i = 1, 1, Application.Match(form, F1.[A:A], 0))
  lig2 = IIf(i = 1, 1, Application.Match(form, F2.[A:A], 0))
  For j = 1 To dercol
    opt = Cells(1, j)
    col1 = IIf(j = 1, 1, Application.Match(opt, F1.[1:1], 0))
    col2 = IIf(j = 1, 1, Application.Match(opt, F2.[1:1], 0))
    v1 = "": v2 = ""
    If IsNumeric(lig1) And IsNumeric(col1) Then v1 = F1.Cells(lig1, col1)
    If IsNumeric(lig2) And IsNumeric(col2) Then v2 = F2.Cells(lig2, col2)
    If v2 = "X" Then _
      Set X = Union(IIf(X Is Nothing, Cells(i, j), X), Cells(i, j))
    If v1 <> "" And v2 = "" Then _
      Set rouge = Union(IIf(rouge Is Nothing, Cells(i, j), rouge), Cells(i, j))
    If v1 = "" And v2 <> "" Then _
      Set vert = Union(IIf(vert Is Nothing, Cells(i, j), vert), Cells(i, j))
  Next
Next
If Not X Is Nothing Then X = "X"
If Not rouge Is Nothing Then rouge.Interior.ColorIndex = 3
If Not vert Is Nothing Then vert.Interior.ColorIndex = 4
End Sub

Cela dit ce qui prend du temps ce sont les recherches par Application.Match.

A+

job75 · 1 Janvier 2012

Re : comparaison de tableaux excel à 2 dimensions (matrices)

Re,

J'ai mesuré les durées d'exécution des 2 versions sur mon portable avec Excel 2010 :

- version (1) => 0,052 s

- version (2) => 0,042 s

Donc un gain de temps de 20%, ce n'est pas considérable.

A+

job75 · 1 Janvier 2012

Re : comparaison de tableaux excel à 2 dimensions (matrices)

Re,

Voici une version (3) plus difficile à comprendre.

Elle permet de diminuer considérablement, en mémorisant dans tablo, le nombre d'appels de la fonction Application.Match :

Code:

Sub Comparer()
Dim F1 As Worksheet, F2 As Worksheet, d As Object
Dim col1 As Variant, col2 As Variant, lig1 As Variant, lig2 As Variant, dercol%
Dim tablo(), i&, j%, form$, opt$, v1$, v2$, X As Range, rouge As Range, vert As Range
Application.ScreenUpdating = False
'---initialisation---
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
On Error Resume Next
Set F1 = Workbooks("ancien.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'ancien.xls' !": Exit Sub
Set F2 = Workbooks("nouveau.xls").Sheets(1)
If Err Then MsgBox "Ouvrez 'nouveau.xls' !": Exit Sub
On Error GoTo 0
'---options classées sans doublon---
Set d = CreateObject("Scripting.Dictionary")
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col2 = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
For i = 1 To col1
d(F1.Cells(1, i).Value) = F1.Cells(1, i).Value
Next
For i = 1 To col2
d(F2.Cells(1, i).Value) = F2.Cells(1, i).Value
Next
Cells(1, 1).Resize(, d.Count) = d.keys
Cells(1, 2).Resize(, col1 + col2 - 1).Sort [B1], Header:=xlNo, Orientation:=xlLeftToRight
'---formules classées sans doublon---
Set d = CreateObject("Scripting.Dictionary")
lig1 = F1.Cells(F1.Rows.Count, 1).End(xlUp).Row
lig2 = F2.Cells(F2.Rows.Count, 1).End(xlUp).Row
For i = 1 To lig1
d(F1.Cells(i, 1).Value) = F1.Cells(i, 1).Value
Next
For i = 1 To lig2
d(F2.Cells(i, 1).Value) = F2.Cells(i, 1).Value
Next
Cells(1, 1).Resize(d.Count) = Application.Transpose(d.keys)
Cells(2, 1).Resize(lig1 + lig2 - 1).Sort [A2], Header:=xlNo, Orientation:=xlTopToBottom
'---remplissage et couleurs---
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim tablo(1, dercol - 1)
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
  form = Cells(i, 1)
  lig1 = IIf(i = 1, 1, Application.Match(form, F1.[A:A], 0))
  lig2 = IIf(i = 1, 1, Application.Match(form, F2.[A:A], 0))
  For j = 1 To dercol
    If i = 1 Then
      opt = Cells(1, j)
      tablo(0, j - 1) = Application.Match(opt, F1.[1:1], 0)
      tablo(1, j - 1) = Application.Match(opt, F2.[1:1], 0)
    End If
    col1 = IIf(j = 1, 1, tablo(0, j - 1))
    col2 = IIf(j = 1, 1, tablo(1, j - 1))
    v1 = "": v2 = ""
    If IsNumeric(lig1) And IsNumeric(col1) Then v1 = F1.Cells(lig1, col1)
    If IsNumeric(lig2) And IsNumeric(col2) Then v2 = F2.Cells(lig2, col2)
    If v2 = "X" Then _
      Set X = Union(IIf(X Is Nothing, Cells(i, j), X), Cells(i, j))
    If v1 <> "" And v2 = "" Then _
      Set rouge = Union(IIf(rouge Is Nothing, Cells(i, j), rouge), Cells(i, j))
    If v1 = "" And v2 <> "" Then _
      Set vert = Union(IIf(vert Is Nothing, Cells(i, j), vert), Cells(i, j))
  Next
Next
If Not X Is Nothing Then X = "X"
If Not rouge Is Nothing Then rouge.Interior.ColorIndex = 3
If Not vert Is Nothing Then vert.Interior.ColorIndex = 4
End Sub

Cette fois la durée d'exécution est très réduite => 0,012 s.

A+

job75 · 2 Janvier 2012

Re : comparaison de tableaux excel à 2 dimensions (matrices)

Bonjour lelfedesboa, le forum,

Juste un petit relookage du code des Scripting.Dictionary.

A+

comparaison de tableaux excel à 2 dimensions (matrices)

lelfedesboa

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

lelfedesboa

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

lelfedesboa

XLDnaute Nouveau

Pièces jointes

lelfedesboa

XLDnaute Nouveau

lelfedesboa

XLDnaute Nouveau

job75

XLDnaute Barbatruc

lelfedesboa

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

comparaison de tableaux excel à 2 dimensions (matrices)

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency