Comparer deux feuilles

VBA
1

Sub ComparaisonDeuxFeuilles()

Dim a, i As Long, dico As Object, txt As String, X As Range
Set dico = CreateObject(« Scripting.Dictionary »)
dico.CompareMode = 1
With Sheets(« Feuil1 »).Cells(1).CurrentRegion
a = .Value
For i = 1 To UBound(a, 1)
txt = Join$(WorksheetFunction.Index(a, i, 0), « , »)
dico(txt) = «  »
Next
End With

With Sheets("Feuil2").Cells(1).CurrentRegion
    .Interior.ColorIndex = xlNone
    a = .Value
    For i = 1 To UBound(a, 1)
        txt = Join$(WorksheetFunction.Index(a, i, 0), ",")
        If dico.Exists(txt) Then
            If X Is Nothing Then
                Set X = .Rows(i)
            Else
            
                Set X = Union(X, .Rows(i))
            End If
        End If
    Next
    'If Not x Is Nothing Then x.Interior.ColorIndex = 43
    If Not X Is Nothing Then X.Value = "0"
    
End With

End Sub

Bonjour tout le monde,
Ce code fonctionne très bien, à condition que le deux lignes dans la Feuil1 et Feuil2 ont la même structure exemple :Feuil1= 1-2-3-4-5 et Feuil2 = 1-2-3-4-5.
est il possible de l’adapter quand les structures ne sont pas le même Exemple Feuil1 = 1-2-3-4-5 et Feuil2 = 3-2-1-5-4. Merci d’avance.

2

Bonjour,

Excel a besoin d’une structure stable pour fonctionner correctement.
Malheureusement, sans fichier, il est difficile de trouver une autre voie à emprunter pour demander à Excel de s’adapter à la structure.
À quelle fréquence cette structure change-t-elle ?
Et si elle change, comment la nouvelle structure est-elle conçue et sous quelles conditions ?
Comment Excel doit-il savoir si cela change ou pas ?

salutation
Johnny

1 « J'aime »
3

Bonjour @Johnny ,
C’est exactement ça !
Mes salutations.

4

bonjour
merci pour votre réponse finalement j’ai trouvé la solution et ça fonctionne comme je le souhaite.
voila le code si ça peut être utile à quelqu’un. Bonne journée

Sub ComparaisonDeuxFeuilles()

Dim a, i As Long, dico As Object, txt As String, X As Range
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets("Feuil1").Cells(1).CurrentRegion
    a = .Value
    For i = 1 To UBound(a, 1)
        txt = Join$(SortArray(WorksheetFunction.Index(a, i, 0)), ",") ' Trie les valeurs avant de les concaténer
        dico(txt) = ""
    Next
End With

With Sheets("Feuil2").Cells(1).CurrentRegion
    .Interior.ColorIndex = xlNone
    a = .Value
    For i = 1 To UBound(a, 1)
        txt = Join$(SortArray(WorksheetFunction.Index(a, i, 0)), ",") ' Trie les valeurs avant de les concaténer
        Dim valuesSet As Object
        Set valuesSet = CreateObject("Scripting.Dictionary")
        valuesSet.CompareMode = 1
        For Each key In dico.keys()
            valuesSet(key) = ""
        Next key
        If valuesSet.Exists(txt) Then
            If X Is Nothing Then
                Set X = .Rows(i)
            Else
                Set X = Union(X, .Rows(i))
            End If
        End If
    Next i
    If Not X Is Nothing Then X.Value = "0"
End With

End Sub

Function SortArray(arr As Variant) As Variant
’ Fonction pour trier un tableau unidimensionnel
Dim i As Long, j As Long
Dim temp As Variant

For i = LBound(arr) To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
        If StrComp(arr(i), arr(j), vbBinaryCompare) > 0 Then
            temp = arr(i)
            arr(i) = arr(j)
            arr(j) = temp
        End If
    Next j
Next i

SortArray = arr

End Function

1 « J'aime »
5 
txt = Join$(Application.Index(a, i, Array(3, 2, 1, 5, 4)), ",")

cette macro, c’est pour combien de lignes ? Elle est lente ?

6

bonjour
1400 lignes,chez moi elle ça prend quelques secondes 20s.

7

je suppose que c’est cacher qui prend beaucoup de temps, dès qu’on a 100 lignes, il faut le faire, autrement cela ralentit la macro. Il faut cacher combien de lignes ? Un autre truc, c’est de mettre quelque chose (un « x ») dans une colonne des lignes à cacher et utiliser un filtre … si 20 sec est trop lent :innocent:

8

Bonjour une suggestion,
Désactiver la mise à jour de l’écran avant la boucle et l’activer après la boucle.

'pour desactiver
Application.ScreenUpdating = False
'La boucle

'pour reactiver
Application.ScreenUpdating = True

Cela vous fera gagner quelques secondes.
Cordialement

9

sans fichier, c’est difficile et c’est cacher ou colorer ? un petit essai

Sub xxxx()

     Dim a, b, i As Long, dico As Object, txt As String, X As Range

     t = Timer
     Set dico = CreateObject("Scripting.Dictionary")
     dico.CompareMode = 1

     With Sheets(" Feuil1").Cells(1).CurrentRegion.Resize(, 5)     'exactement 5 colonnes !
          a = .Value
          For i = 1 To UBound(a, 1)
               txt = Join$(WorksheetFunction.Index(a, i, 0), "")
               dico(txt) = ""
          Next
     End With

     Set c = Sheets("Feuil2").Cells(1).CurrentRegion
     With c
          .Interior.ColorIndex = xlNone
          a = .Value
          For i = 1 To UBound(a, 1)
               txt = Join$(Application.Index(a, i, Array(3, 2, 1, 5, 4)), ",")     'aussi 5 colonnes dans cette séquence
               If Not dico.Exists(txt) Then b(i, 1) = "x"
          Next

          With .Offset(, 26).Resize(, 1)     'plage auxiliaire, 1 colonne 26 colonnes vers droite
               .Value = b
               .AutoFilter 1, "x"
               'eventuellement problème avec entête, à résoudre ...
               c.SpecialCells(xlVisible).Interior.ColorIndex = 43
               .AutoFilter
               .ClearContents                'vider cette plage
          End With
     End With

     MsgBox Format(Timer - t, "0.00")
End Sub
10

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.