comparaison de liste

[raskok]

Bonjour a tous,

Pourriez vous m'aider a modifier la formule du fichier joint.
Actuellement les données sont comparées sur la colonne A B et C , si une des valeurs d'une des lignes est différente alors il y a une ligne "nouveau" et "disparu" qui apparaissent.
Je voudrais comparer la ligne que sur la valeur de la colonne C.
merci d'avance pour votre aide a tous
désolé de relancer ma demande mais je m'arrache les cheveux

 

[Dranreb]

Re : comparaison de liste

Bonsoir.

Comme ça :

Sub Compare()
Dim Dico As Object, Te(), N As Long, L As Long, X As String, Clé(), Itm(), Statut As Byte
Feuil3.Cells.Clear
Set Dico = CreateObject("Scripting.dictionary")
For N = 1 To 2
   Te = Worksheets(N).UsedRange.Value
   For L = 1 To UBound(Te)
      X = Join(Array(Trim$(Te(L, 1)), Trim$(Te(L, 2)), Trim$(Te(L, 3))), " ")
      Dico(X) = Dico(X) + N: Next L, N
Clé = Dico.keys
Itm = Dico.items
For N = 0 To UBound(Clé)
   Feuil3.[A:C].Rows(N + 1).Value = Split(Clé(N), " ")
   Statut = Itm(N)
   With Feuil3.Cells(N + 1, "D")
      .Value = Choose(Statut, "Disparu", "Nouveau", "Commun")
      .Interior.ColorIndex = Choose(Statut, 4, 5, 2): End With
   Next N
End Sub

Remarque s'il y avait 3 feuilles et donc 7 textes prévus il suffirait de faire Dico(X) = Dico(X) + 2 ^ (N - 1) afin que le poids de la 3ième soit de 4 et non de 3.

P.S. Mais attendez, il me semble que c'était déjà ce que faisait votre code. Que sur la colonne C ? Désolé je ne comprends pas bien. On pourrait évidemment s'arranger pour n'avoir qu'une fois chaque combinaison des 2 1ères colonnes existante dans au moins une des listes, mais dans ce cas que voudriez vous voir apparaître dans les colonnes C et D selon qu'elle n'existe que dans la 1ère, que dans la 2ième, dans les deux mais avec valeurs différentes en colonne C et enfin qu'elles soient identiques ?

Un essai dans ce sens:

Sub Compare()
Dim Dico As Object, Te(), N As Long, L As Long, X As String, Y(), Clé(), Itm(), Statut As Byte
Feuil3.Cells.Clear
Set Dico = CreateObject("Scripting.dictionary")
ReDim Y(1 To 2)
For N = 1 To 2
   Te = Worksheets(N).UsedRange.Value
   For L = 1 To UBound(Te)
      X = Trim$(Te(L, 1)) & " " & Trim$(Te(L, 2))
      If Dico.Exists(X) Then Y = Dico(X) Else Y(3 - N) = Empty
      Y(N) = Te(L, 3): Dico(X) = Y: Next L, N
Clé = Dico.keys
Itm = Dico.items
For N = 0 To UBound(Clé)
   Feuil3.[A:B].Rows(N + 1).Value = Split(Clé(N), " ")
   Y = Itm(N)
   If IsEmpty(Y(1)) Then
      Feuil3.Cells(N + 1, "C").Value = Y(2)
      Feuil3.Cells(N + 1, "D").Value = "Nouveau"
   ElseIf IsEmpty(Y(2)) Then
      Feuil3.Cells(N + 1, "C").Value = Y(1)
      Feuil3.Cells(N + 1, "D").Value = "Disparu"
   ElseIf Y(2) <> Y(1) Then
      Feuil3.Cells(N + 1, "C").Value = Y(2)
      Feuil3.Cells(N + 1, "D").Value = "Changé: " & IIf(Y(2) > Y(1), "+", "") & Y(2) - Y(1)
   Else
      Feuil3.Cells(N + 1, "C").Value = Y(2)
      Feuil3.Cells(N + 1, "D").Value = "Commun": End If
   Next N
End Sub

Mais ça ne doit pas encore être ça parce qu'il y a une paire de doublons sur la 1ère liste dans les colonne A et B: celle ou elles sont vides.

 

[ROGER2327]

Re : comparaison de liste

Bonjour raskok, Dranreb.

Un essai sur des bases voisines de celles de Dranreb :​

Sub Compare()
Dim i&, j&, k&, b%, c%, d$, dFl$, Fl%, fFl(), t(), tf As Boolean, Dic As New Scripting.Dictionary

    fFl = Array("liste totale", "nouvelle liste") 'onglets à traiter

    b = 1: c = 3 'b = n° première colonne:c = n° dernière colonne

    dFl = "Feuil3" 'onglet de destination

    t = Array("")
    ReDim t(b To c)
    For Fl = 0 To UBound(fFl)
        i = 0
        k = 2 ^ Fl
        On Error GoTo F
        With Worksheets(fFl(Fl))
            On Error GoTo 0

            Do
                tf = False
                i = i + 1
                For j = b To c
                    t(j) = Trim(.Cells(i, j).Value)
                    tf = tf Or t(j) <> ""
                Next
                If tf Then
                    d = Join(t, "¤")
                    If Not Dic.Exists(d) Then
                        Dic.Add d, k
                    Else
                        If Dic(d) < k Then Dic(d) = Dic(d) + k
                    End If
                End If
            Loop While tf 'arrêt sur la première ligne vide

S:      End With
    Next

    With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
    On Error GoTo E
    With Worksheets(dFl)
        .Cells.Clear
        For i = 0 To Dic.Count - 1
            Select Case Dic.items(i)
                Case 1: d = "Disparu": j = vbGreen: k = vbBlack
                Case 2: d = "Nouveau": j = vbBlue: k = vbWhite
                Case 3: d = "Commun": j = xlNone: k = vbBlack
                Case Else: d = Empty: j = xlNone: k = vbBlack
            End Select
            With .Cells(i + 1, 1)
                .Resize(, c - b + 1).Value = Split(Dic.Keys(i), "¤")
                With .Offset(, c - b + 1)
                    .Value = d
                    .Interior.Color = j
                    .Font.Color = k
                End With
            End With
        Next
    End With
R:  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
Exit Sub

'=================== Gestion d'erreurs ===================

F:
    MsgBox "La feuille «" & fFl(Fl) & "» n'existe pas."
    Resume S
E:
    MsgBox "Erreur imprévue !"
    Resume R

End Sub

ROGER2327
#6841

Mardi 17 Absolu 141 (Céphalorgie - Vacuation)
3 Vendémiaire An CCXXII, 0,8926h - châtaigne
2013-W39-2T02:08:32Z

 

[BOISGONTIER]

Re : comparaison de liste

Bonjour,

Cf PJ

JB

 

[raskok]

Re : comparaison de liste

Bonjour à tous,
Effectivement l'idée fusion est top
le seul hic, c'est que je souhaite que la colonne "code" reste en 3éme position
Nom/prenom/code
Merci d'avance pour votre aide

 

[BOISGONTIER]

Re : comparaison de liste

Bonjour,

cf pj

jb

 

[raskok]

Re : comparaison de liste

super mais il semble avoir un bug ,
s'il n'y a pas de nouveau ou des dossiers supprimés il bloque
ex: d'une liste identique
merci pour votre aide

 

[BOISGONTIER]

Re : comparaison de liste

Voir PJ

http://boisgontierjacques.free.fr/fichiers/Cellules/Compare2BD_4.xls

JB

 

[raskok]

Re : comparaison de liste

MercIIIIII
Fonctionne nikel
Un GRAND BRAVOOOOOO

 

[raskok]

Re : comparaison de liste

Salut à tous,
j'ai un petit souci avec le logiciel ci-joint
en effet lorsque je rajoute des infos a gauche sur la base 1
et lorsque je fais la fusion, pour la suppression, il prends les infos et decale vers la droite les infos "etat"
voir exemple ligne rouge
merci d'avance pour votre aide