comment trouver des lignes identiques dans 2 feuilles

filou60

XLDnaute Nouveau
Bonjour,
J'ai 2 feuilles dans un meme classeur avec chacune d'elle 2000 Lignes et 10 colonnes
Je cherche à comparer les lignes identiques
en exemple si la ligne de A1 à A10 de la feuille 1 se trouve en feuille 2
en poussant le bouchon un peu plus loin si je pouvais colorier cette ligne
Merci pour votre aide
 

filou60

XLDnaute Nouveau
Merci pour ta réponse, voici un exemple
en gros il faut retrouver dans la feuilles 1 les lignes strictement identique dans la feuille 2
dans cette exemple c'est la ligne de A6 à J6
 

Pièces jointes

  • compare lignes dans 2 feuilles.xls
    30.5 KB · Affichages: 33

thebenoit59

XLDnaute Accro
Bonjour Filou.

Je te joins le fichier avec le code.
Pour le forum, je colle ci-dessous le code réalisé. Il doit y avoir plus court.

VB:
Sub doublonLigne()
'--- Déclaration des variables ---'
Dim t1, t2
Dim d1 As Object, d2 As Object
Dim w As Workbook
Dim f1 As Worksheet, f2 As Worksheet

'--- Enregistrement du classeur et des feuilles ---'
Set w = ThisWorkbook
Set f1 = w.Sheets(1): Set f2 = w.Sheets(2)

'--- Remise à zéro du surlignage ---'
f1.Cells.Interior.Pattern = xlNone
f2.Cells.Interior.Pattern = xlNone

'--- Enregistrement des tableaux ---'
t1 = f1.[a1].CurrentRegion: t2 = f2.[a2].CurrentRegion

'--- Création des dictionnaires ---'
Set d1 = CreateObject("Scripting.Dictionary"): Set d2 = CreateObject("Scripting.Dictionary")

'--- Appel des procédures d'alimentation des dictionnaires ---'
Call alimentationDico(d1, t1)
Call alimentationDico(d2, t2)

'--- Appel de la procédure de comparaison des dictionnaires ---'
Call comparaisonLigne(f1, f2, d1, d2)

End Sub

Sub alimentationDico(d As Object, t)
Dim i&, j As Byte
Dim n$

'--- Boucle sur le tableau pour enregistrement du texte ---'
For i = LBound(t) To UBound(t)
    n = ""
    For j = LBound(t, 2) To UBound(t, 2)
        n = n & t(i, j)
    Next j
    '--- La clef du dictionnaire est le texte collé des 10 colonnes pour chaque ligne, l'item est le numéro de ligne ---'
    d(n) = i
Next i

End Sub

Sub comparaisonLigne(f1 As Worksheet, f2 As Worksheet, d1 As Object, d2 As Object)
Dim k
Dim i&

'--- Boucle de chacune des clefs du dictionnaire 1 ---'
For Each k In d1.Keys
    '--- Si la clef se trouve dans le dictionnaire 2, surlignage de la ligne dans les deux feuilles ---'
    If d2.exists(k) Then
        f1.Cells(d1(k), 1).Resize(, 10).Interior.Color = 65535
        f2.Cells(d2(k), 1).Resize(, 10).Interior.Color = 65535
    End If
Next k

End Sub
 

Pièces jointes

  • compare lignes dans 2 feuilles.xls
    47.5 KB · Affichages: 41

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG