macro pour comparer 2 listes sous excel

Question

Bonjour à tous, 

j'espère que vous allez pouvoir me venir en aide car je n'arrive pas à résoidre un probléme. voila je vous explique:

j'ai 2 tableaux de même structutres dans 2 feuilles différentes d'un même classeur que je souhaite comparer pour moi gagner du temps et ne pas regarder ligne par ligne.

exemple du tableau1:
cug       libellé        valeur       quantités
123       pois           52           2
569       carottes     125         9

exemple du tabkleau 2:
cug       libellé        valeur      quantités
895       salades      56           5
123       pois           45           1

je souhaiterais donc avoir une macro qui puisse me comparer la colonne A de la feuille 1 à la colonne A de la feuille 2 en me coloriant les cellules identiques.

est ce possible???

merci d'avance pour votre aide



Configuration: Windows XP / Internet Explorer 6.0

lermite222 · Accepted Answer

Bonjour,
il TE FAUT une maco !!! içi ont n'exige pas mon ami, nous sommes tous bénévoles et répondons quand nous avons le temps.
Ca tombe bien pour toi, j'avais un peu de temps. 
Sub Compare()
Dim Lig1 As Long, Derlig1 As Long, Derlig2 As Long, Cp As Variant
Dim Lig2 As Long
    Derlig1 = Sheets("Feuil1").Range("A65535").End(xlUp).Row
    Derlig2 = Sheets("feuil2").Range("A65535").End(xlUp).Row
    With Sheets("Feuil2")
        For Lig1 = 2 To Derlig1
            Cp = Sheets("feuil1").Cells(Lig1, "A")
            For Lig2 = 2 To Derlig2
                If Cp = .Cells(Lig2, "A") Then
                    .Cells(Lig2, "A").Interior.ColorIndex = 6
                End If
            Next Lig2
        Next Lig1
    End With
End Sub
A+

BenitoGrande · Answer

Tu ne t'y connais pas du tout en VB?

lermite222 · Answer

Attention au point devant cells...   
if cp > .cells(...  
Les valeurs sont sur la mêmes ligne ? de toutes façon, si c'est pas le cas il faut faire autrement, il faudrait un critère de contrôle. 


L'expérience instruit plus sûrement que le conseil. (André Gide)    
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

lermite222 · Answer

Si c'est sur la même ligne...
Sub Compare2()
Dim Lig1 As Long, Derlig1 As Long, Derlig2 As Long, Cp As Variant
Dim Lig2 As Long
    Derlig1 = Sheets("Feuil1").Range("C65535").End(xlUp).Row
    Derlig2 = Sheets("feuil2").Range("C65535").End(xlUp).Row
    'Pour stopper à la dernière comparaison possible
    If Derlig2 < Derlig1 Then Derlig1 = Derlig2
    With Sheets("Feuil2")
        For Lig1 = 2 To Derlig1
            If Sheets("Feuil1").Cells(Lig1, "C") > .Cells(Lig1, "C") Then
                .Cells(Lig1, "C").Interior.ColorIndex = 4
            End If
        Next Lig1
    End With
End Sub

lermite222 · Answer

les pois, y sont sur quel colonne ?

lermite222 · Answer

J'espère que tes renseignements sont justes...
Sub Compare3()
Dim Lig1 As Long, Derlig1 As Long, Derlig2 As Long, Cp As Variant
Dim Lig2 As Long, FR1 As Worksheet, FR2 As Worksheet
    Set FR1 = Sheets("Feuil1")
    Set FR2 = Sheets("Feuil2")
    Derlig1 = FR1.Range("B65535").End(xlUp).Row
    Derlig2 = FR2.Range("B65535").End(xlUp).Row
    For Lig1 = 2 To Derlig1
        Cp = FR1.Cells(Lig1, "B")
        For Lig2 = 2 To Derlig2
            If Cp = FR2.Cells(Lig2, "B") Then
                If FR1.Cells(Lig1, "C") > FR2.Cells(Lig2, "C") Then
                    FR2.Cells(Lig2, "C").Interior.ColorIndex = 3
                ElseIf FR1.Cells(Lig1, "C") < FR2.Cells(Lig2, "C") Then
                    FR2.Cells(Lig2, "C").Interior.ColorIndex = 4
                Else
                    FR2.Cells(Lig2, "C").Interior.ColorIndex = xlNone
                End If
                Exit For
            End If
        Next Lig2
    Next Lig1
End Sub
A+

lermite222 · Answer

c'est <>
A+

lermite222 · Answer

Tu dis..
UNE DERNIERE CHOSE ET APRES JE T'EMBETE PLUS !!!

Bon, beh maintenant cherche un peu par toi même, quand tu auras un début de code revient pour l'optimiser. 
Je ne vais pas faite toute ton aplli... non mais.. 
L'expérience instruit plus sûrement que le conseil. (André Gide)   
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

lermite222 · Answer

Sub somme()
Dim Lig As Long, FR As Worksheet
Dim Rouge As Integer, Vert As Integer, Gris As Integer
    Set FR = Sheets("SAP") 'adapter le nom de la feuille
    For Lig = 1 To FR.Range("C65535").End(xlUp).Row
        Select Case FR.Cells(Lig, 3).Interior.ColorIndex
        Case 3: Rouge = Rouge + 1
        Case 4: Vert = Vert + 1
        Case 15: Gris = Gris + 1
        End Select
    Next Lig
    MsgBox "Le nombre de cellule(s)..." & Chr(13) _
        & "Rouge = " & Rouge & Chr(13) _
        & "Vert = " & Vert & Chr(13) _
        & "Gris = " & Gris
End Sub

lermite222 · Answer

Autre façon de faire.. 
Dans le module coller le code... 
Public Function NbCouleurCell(Couleur As Integer) As Long 
Dim Lig As Long
    Application.Volatile 
    For Lig = 1 To Range("C65535").End(xlUp).Row 
        If Cells(Lig, 3).Interior.ColorIndex = Couleur Then NbCouleurCell = NbCouleurCell + 1 
    Next Lig 
End Function
Dans la feuille mettre dans la cellule où tu veux le résultat 
    =NbCouleurCell(3) ' pour le rouge
En fait, l'argument que tu met est le N° de la couleur. 
Note : Le fait de modifier la couleur d'une cellule n'appel pas le recalcul, y faut donc taper F9 pour recalculer. 

L'expérience instruit plus sûrement que le conseil. (André Gide)   
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

Macro pour comparer 2 listes sous excel

10 réponses

Discussions similaires

Newsletters