Maccro de comparaison cellule à cellule

[prozqck]

Bonjour à tous,

Débutant en VBA, je me trouve confronté à un problème que j'esseye de résoudre par moi-même depuis quelques jours maintenant, mais duquel je ne me dépatouille pas.

Je dois comparer les cellules de 2 feuilles excel 2003 formatées strictement de la même façon (même intitulé de colonne et données à la même place). Les cellules identiques seront colorées en vert, celles différentes laissées blanche ou mises en rouge.

Je sais résoudre ce genre de problème avec les fomules excel, mais je dois automatiser le processus, ainsi j'aimerai que la maccro marche pour n'importe quel problème de ce type, donc en gros qu'elle compare automatiquement toutes les cellules non vides de chaque feuilles une à une.

Les commentaires dans le codage sont les bienvenus afin de m'aider à comprendre ce que vous faites, après tout je suis la pour ça

Je me tiens a votre disposition pour apporter des précisions éventuelles à mon problème si je n'ai pas été assez explicite. Vous trouverez en pièce jointe un exemple de fichier que je pourrai avoir a traiter (j'ai simplifier a titre d'exemple, ceux que je dois comparer sont beaucoup plus lourd, d'où la nécéssité d'une maccro).

Je poste également une maccro que j'ai trouvée sur internet et qui fonctionne dans mon cas mais qui ne répond pas exactement a ce que l'on me demande, elle fonctionne par ligne et n'automatise pas le processus puisqu'il faut spécifié le nombre de colonnes.

Sub ColorerCommuns()
ncol = 10 ' nombre de colonnes
Application.ScreenUpdating = False
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
f1.Range("A1").CurrentRegion.Interior.ColorIndex = xlNone
f2.Range("A1").CurrentRegion.Interior.ColorIndex = xlNone
a = f1.Range("A1").CurrentRegion.Value
b = f2.Range("A1").CurrentRegion.Value
Set mondico1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a)
temp = ""
For K = 1 To ncol: temp = temp & a(i, K): Next K
mondico1(temp) = i
Next i
For i = 1 To UBound(b)
temp = ""
For K = 1 To ncol: temp = temp & b(i, K): Next K
If mondico1.exists(temp) Then
f1.Cells(mondico1(temp), 1).Resize(, 11).Interior.ColorIndex = 4
f1.Cells(mondico1(temp), 10) = i 'mondico1(temp)
f2.Cells(i, 1).Resize(, 11).Interior.ColorIndex = 4
f2.Cells(i, 10) = mondico1(temp)
End If
Next
End Sub

Bonne journée a tous, et merci à ceux qui s'interesseront a mon problème !

 

[Odesta]

Re : Maccro de comparaison cellule à cellule

Bonjour et bienvenu par ici

Voici un petit programme que je viens de faire : vous devez choisir les feuilles à comparer, la première sera colorée.

Cordialement
Olivier

 

[prozqck]

Re : Maccro de comparaison cellule à cellule

Merci beaucoup Odesta, votre maccro fonctionne bien et répond a mes attentes.

bonne journée

 

[Gorfael]

Re : Maccro de comparaison cellule à cellule

Salut prozqck, Odesta et le forum
C'est un scandale, y en a de plus rapide que moi !
Comme je l'ai faite, autant la donner :

Sub Test()
On Error GoTo Err_Test
'Si excel détecte une erreur, aller à l'adresse Err_Test
'Déclaration ==========================
Dim F1 As Worksheet, F2 As Worksheet
Dim Cel As Range, Cel_R As Range
'MEI ==================================
Application.ScreenUpdating = False
'Blocage rafraichissement écran
'Feuilles à tester --------------------
Set F1 = Sheets("Feuil1")       'Workbooks("classeur").Sheets("Feuille")
Set F2 = Sheets("Feuil2")       'si elles ne sont pas dans le même fichier
'détermination de la plage ------------
Set Cel_R = F1.Range("A1").SpecialCells(xlCellTypeLastCell)
'cellule=la plus basse et à droite des lignes/colonnes utilisées de F1
Set Cel = F2.Range("A1").SpecialCells(xlCellTypeLastCell)
If Cel_R.Column < Cel.Column Then Set Cel_R = F1.Cells(Cel_R.Row, Cel.Column)
If Cel_R.Row < Cel.Row Then Set Cel_R = F1.Cells(Cel.Row, Cel_R.Column)
'on prend comme cellule de référence celle à l'intersertion de la ligne la plus basse
'et la colonne la plus à droite des 2 feuilles
'Traitement ===========================
For Each Cel In F1.Range(F1.[A1], Cel_R)
'Pour chaque cellule de la plage A1 à Cel_R de F1
    If Cel = F2.Cells(Cel.Row, Cel.Column) Then
    'si Cel=cellule de même adresse sur l'autre feuille, alors
        Cel.Interior.ColorIndex = 4
        'fond de cel=vert
    Else    'sinon (2 cellules différentes)
        Cel.Interior.ColorIndex = 3
        'fond de cel=rouge
    End If
    F2.Cells(Cel.Row, Cel.Column).Interior.ColorIndex = Cel.Interior.ColorIndex
    'on colore La cellule en F2 de la couleur de celle en F1
Next Cel
'cellule suivante
'Sortie ===================================
Sort_Test:  'adresse de sortie
Application.ScreenUpdating = True
'remise en route rafraichissement écran
Exit Sub
'sortie de la macro
'Gestion des erreurs ======================
Err_Test:   'adresse de gestion des erreurs
MsgBox Err.Description, , "Erreur Excel n°" & Err.Number
'Boîte de dialogue
Resume Sort_Test
'continuer à l'adresse de sortie
End Sub

Petites remarques anodines :
Utiliser les balises pour le code facilite sa lecture et évite les smley intempestifs.
Par principe, pour toute instruction du niveau application, je fais une gestion des erreurs et je remets l'instruction comme elle était avant la macro (ici, on n'en aurait pas eu besoin).
SCREENUPDATING : permet d'augmenter la rapidité d'exécution de la macro. Elle est du domaine Application, et vraisemblablement se remet en route toute seule. Mais quand ??? C'est pour ça que je la remets en route dans la macro.
A+

 

[prozqck]

Re : Maccro de comparaison cellule à cellule

Merci Gorfael, malgré que Odesta a été plus rapide, ta maccro fonctionne également très bien, je me la garde sous le coude !!

Bonne journée