Macro Comparaison Complexe

[jacquesJ]

[Toutes Versions]Macro Comparaison Complexe

Bonjour a Tous,

Voila je débute tout juste en VBA et en programmation. Je sollicite votre aide car je suis quelque peu bloqué sur un projet que je voudrais faire.

Petit Topo:

J'ai 2 Feuilles excel ouvertes dans un classeur.

Premiere Feuille:
-------A---------B----------------C-------------D-----------E
1--Modele---Reference---------TYPE-----------couleur-----MARQUE
2 ---serie1--------1-------------hybride----------bleu--------BMW
3 ---serie1--------2-------------motrice----------Rose---------BMW
4----blabla--------1-------------hybride----------Noir--------toyota
5----TT----------1-------------hybride-----------Noir----------audi
6----TT----------2------------motrice-----------Jaune---------audi
7----TT----------2------------course------------rose---------audi


Deuxieme Feuille:

-------A---------B----------------C-------------D-----------E
1--Modele---Reference---------TYPE-----------couleur---MARQUE
2 ---M5--------1-------------hybride----------bleu--------BMW
3 ---M5--------2-------------motrice----------Rose---------BMW
4----titi--------1-------------hybride----------Noir--------toyota
5----R8----------1-------------hybride---------Noir----------audi
6----R8----------2------------motrice-----------Jaune---------audi
7----R8----------2------------course------------vert---------audi



On peut voir dans ces tableaux qu'on a des groupes de marques et de voitures.

La colonne B , reference , montre que si la valeur = 1 alors c'est la voiture "principale" et si la valeur = 2
alors ce sont des déclinaisons du meme modele.

J'aimerais comparer les données équivalentes de la feuille 1 a celles de la Feuille 2.
Que signifie équivalente? On a 3 colonnes de comparaison qui seront forcément identiques (MARQUE,TYPE,Reference), et grace a celles-ci je pourrais comparer les autres colonnes qui elles pourraient différer
.En gros, si Marque(feuille1)=Marque(Feuill2) ET TYPE(Feuille1)=TYPE(Feuill2) ET Reference("Feuille1")=Reference(Feuille2) alors on compare les 2 lignes.cellules a cellules.Si il y a une erreur copier la ligne de la deuxieme feuille dans une nouvelle feuille excel.

Il faut ignorer le Modele, car il sera toujours différent.
En Gros au finale je devrais avoir une Feuille avec les lignes de Feuille 2 qui ont eu une différence lors de la comparaison.

Bien sur j'ai mis que le minimum ici, sinon il y a des milliers de lignes et des dizaines d'autre colonnes.
C'est pour ca qu'il faut un code VBA pour automatiser ca a grande echelle.

Je suis conscient que j'en demande beaucoup,c'est assez complexe je pense ,mais je seche la.Je ne sais pas trop comment m'y prendre.
Si vous avez au moins des indications, je suis preneur.

Bref je vous remercie de me lire, et je suis dispo pour des infos supplémentaires.

 

[jacquesJ]

Re : Macro Comparaison Complexe

Salut, je vous remercie encore en tout cas.

Sinon pour les tests Skoobi:

J'ai 167 colonnes et qu'une donnée fausse par ligne dans tous les cas.

1000 lignes: 3s et 4 lignes d'erreurs.
5000 lignes: 68s et 6 lignes
5000 lignes: 69s et 353 lignes

Voili voilou

 

[skoobi]

Re : Macro Comparaison Complexe

Re,

C'est vraiment super ce que tu as fait.Un code de brute.

Euuhh au fait, moi je préfère plutôt le demi-sec au brut, ipppss .

 

[jacquesJ]

Re : Macro Comparaison Complexe

Salut à tous, je remonte ce topic car j'ai un petit souci avec la macro qu'a fait Skoobi.

Les colonnes a comparer ne se suivent pas, donc il faudrait que j'utilise Array comme le dit Skoobi dans son code. Seulement j'ai du mal a l'utiliser et l'integrer dans ce dernier. Quelqu'un aurait une idée pour dire par exemple, comparer colonnes 2 à 7, 10 a 22 etc...

Merci a tous.

Option Compare Text 'pas de distinction entre majuscule et minuscule
Sub CompareSkoobi_v2()
'Déclaration de variables
Dim BDDSource As Variant, BDDCompare As Variant, Tresultat() As Variant, TColDiff() As Variant
Dim i As Long, j As Long, k As Long, NbCol As Long, LigSuiv As Long ', ColSource As Variant, ColCompare As Variant
Dim RefTypMarq As String, RefTypMarqCompare As String, ColoreAddrr As String  ', LigSource As String, LigCompare As String
'on définie la première et dernière colonne pour le résultat
'ATTENTION: la disposition doit être la même entre les 2 feuilles et toujours laisser "ColDebut" à 1:
Const ColDebut As Long = 1, ColFin As Long = 167
'on définie la première et dernière colonne pour la comparaison. Si les colonnes ne se suivent pas, il faudra créer
'une liste "Array".
Const ColDebutComp As Long = 2, ColFinComp As Long = 167
'on définie les colonnes REFERENCE, TYPE et MARQUE (pour les 2 feuilles)
Const ColRef As Long = 2, ColType As Long = 3, ColMarq As Long = 5
'pour voir le temps d'execution (pour beaucoup de données)
t = Timer
Application.ScreenUpdating = False
LigSuiv = 0
'on vide la feuille 3
Sheets("Feuil3").Cells.Clear
'transfert de la liste de données de la feuil1 vers le tableau VBA "BDDSource" ATTENTION: cela suppose que le tableau
'commence en cellule A1 (entête)
With Sheets("Feuil1")
  BDDSource = .Range("A2", .Cells(.Range("A2").End(xlDown).Row, ColFin))
End With
'transfert de la liste de données de la feuil2 vers le tableau VBA "BDDCompare" ATTENTION: cela suppose que le tableau
'commence en cellule A1 (entête)
With Sheets("Feuil2")
  BDDCompare = .Range("A2", .Cells(.Range("A2").End(xlDown).Row, ColFin))
End With
'la boucle "i" correspond à chaque ligne de la feuille 1 mais commence toujours à 1 (tableau VBA)
For i = LBound(BDDSource, 1) To UBound(BDDSource, 1)
'on concatène REFERENCE, TYPE et MARQUE de la ligne "i" de la feuil1 dans "RefTypMarqSource"
  RefTypMarqSource = UCase(BDDSource(i, ColRef)) & "#" & UCase(BDDSource(i, ColType)) & "#" & UCase(BDDSource(i, ColMarq))
'la boucle "j" correspond à chaque ligne de la feuille 2 mais commence toujours à 1 (tableau VBA)
  For j = LBound(BDDCompare, 1) To UBound(BDDCompare, 1)
'on initialise "ColoreAddrr", "NbCol" et "TColDiff"
    ColoreAddrr = "": NbCol = 0: Erase TColDiff
'on concatène REFERENCE, TYPE et MARQUE de la ligne "j" de la feuil2 dans "RefTypMarqCompare"
    RefTypMarqCompare = UCase(BDDCompare(j, ColRef)) & "#" & UCase(BDDCompare(j, ColType)) & "#" & UCase(BDDCompare(j, ColMarq))
'on vérifie l'égalité:
    If RefTypMarqCompare = RefTypMarqSource Then
'on compare la ligne, cellule par cellule pour identifier les cellules différentes:
      For k = ColDebutComp To ColFinComp
        If BDDSource(i, k) <> BDDCompare(j, k) Then
'on récupère les colonnes dans "TColDiff" si différences
          NbCol = NbCol + 1
          ReDim Preserve TColDiff(1 To NbCol)
          TColDiff(NbCol) = k
        End If
      Next
'si des cellules sont trouvées:
      If NbCol > 0 Then
        LigSuiv = LigSuiv + 1
'on identifie les cellules pour les colorier:
        For k = LBound(TColDiff) To UBound(TColDiff)
          ColoreAddrr = ColoreAddrr & Cells(LigSuiv, TColDiff(k)).Address(0, 0) & ","
        Next
        ColoreAddrr = Left(ColoreAddrr, Len(ColoreAddrr) - 1)
'on cré "Tresultat" afin de copier "d'un cout" dans la feuil3
        ReDim Preserve Tresultat(1 To ColFin, 1 To LigSuiv)
        For k = ColDebut To ColFin
          Tresultat(k, LigSuiv) = BDDCompare(j, k)
        Next
'et on applique la couleur sur les cellules différentes de la ligne analysée
        With Sheets("Feuil3")
          .Range(ColoreAddrr).Interior.ColorIndex = 45  'orange clair
        End With
      End If
    End If
  Next j
Next i
With Sheets("Feuil3")
'la copie:
  .Range("A1", .Cells(LigSuiv, ColFin)).Value = Application.Transpose(Tresultat)
'on récupère la ligne d'entête de la feuil1:
  .Rows(1).Insert Shift:=xlDown
  Sheets("Feuil1").Rows(1).Copy .Rows(1)
End With
'affiche le temps d'execution, en seconde, dans la fenêtre d'execution (Ctrl+G)
Debug.Print Timer - t
End Sub