Comparaison de 2 tableaux

Iscape

XLDnaute Nouveau
Bonjour,

Mon problème concerne la comparaison de 2 tableaux et la mise en évidence des différences.

J'ai deux tableaux avec mes références en colonne A, des valeurs en colonne B à D.
D'un tableau à l'autre, certaines lignes peuvent avoir disparu, des valeurs peuvent avoir changé mais les colonnes restent identiques.

Je souhaite mettre en évidence (en rouge) les valeurs différentes dans le tableau de la Feuil1 par rapport à celui de la Feuil2.

Je voudrais utiliser une Macro VBA (mon fichier original contient 1000 lignes et une 30aine de colonne) mais je balbutie au niveau des boucles For.

J'ai tenté ceci (mais ça ne fonctionne pas):
Code:
    Dim x
    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To 20
        x = Application.Match(Worksheets(1).Cells(4, i), Worksheets(2).Range("A1:A20"))
        Range("A1") = x
        For j = 1 To 10
        If Worksheets(1).Cells(j, i) <> Worksheets(2).Cells(j, x) Then
            Cells(j & i).Select
            With Selection.Font
                .Color = 33333
            End With
        End If
        
        Next j
    Next i


Comment puis-je faire?

Merci par avance
 

Pièces jointes

  • Compare.xlsm
    9.9 KB · Affichages: 49
  • Compare.xlsm
    9.9 KB · Affichages: 44
  • Compare.xlsm
    9.9 KB · Affichages: 47

flyonets44

XLDnaute Occasionnel
Re : Comparaison de 2 tableaux

voici du code pour réaliser ton travail
Sub Comparecolonnes()
'COMPARAISON DANS UNE MEME FEUILLE DE 2 COLONNES,L UNE APRES L AUTRE
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim RngA As Range, RngB As Range, Cll As Object
Dim Cola&, Colb&, Choix&, Rw&
With ActiveSheet
Range("A2").CurrentRegion.Interior.ColorIndex = xlNone
Cola = 1: Colb = 2
Rw = 2
Set RngA = Range(Cells(Rw, Cola), Cells(Rows.Count, Cola).End(xlUp))
Set RngB = Range(Cells(Rw, Colb), Cells(Rows.Count, Colb).End(xlUp))

Choix = 1
Select Case Choix
'BALAYAGE DES 2 COLONNES
Case Is = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll) >= 1 Then
With RngB
.Find(Cll).Interior.ColorIndex = 33 'colorie l'item trouvé
End With
End If
Next
Rw = 2
'Case Is = 1, 2
For Each Cll In RngA
If Application.CountIf(RngB, Cll) >= 1 Then
With RngA
.Find(Cll).Interior.ColorIndex = 35 ' colorie l'item trouvé
End With
End If
Next
End Select
Set RngA = Nothing: Set RngB = Nothing
End With
Application.Calculation = xlCalculationAutomatic
'MsgBox "terminé"
End Sub

Cordialement
Flyonets
 

Discussions similaires

Réponses
11
Affichages
358

Statistiques des forums

Discussions
312 527
Messages
2 089 353
Membres
104 134
dernier inscrit
marylore