comparaison des lignes de deux feuilles

**safouunette** · 23/11/2010, 15h41

Bonjour,
Je cherche à copier les lignes n'existants pas dans la premiere feuille qui me servira d'une BD. Donc je veux copier les lignes de la deuxieme feuille qui ne sont pas identiques (que les lignes completement identiques ne seront pas collées) j'ai essayé de modifier un code que j'ai trouvé sur le forum mais je n'arrive pas à trouver le bon résultat dans la copie j'ai des lignes qui se recopient et qui sont pareilles.
Ps: dans ma base de donnée sur la feuille 1, j'ai des redendances au niveau de la première colonne (donc je dois comparer les lignes entières)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub compare1()
Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long, j As Long
Dim k As Byte
Dim c As Range, v As Range, w As Range
Dim Data1 As String, Data2 As String
Dim WbA As Workbook, WbN As Workbook
Dim WsA As Worksheet, WsN As Worksheet
 
Set WbN = ThisWorkbook
Set WbA = Application.Workbooks.Open("C:\Archives PROG\RECAP FICHE.xls")
Set WsA = WbA.Worksheets("RECAP")
Set WsN = WbN.Worksheets("restr")
 
Application.ScreenUpdating = False
WsN.Range("I:I").EntireColumn.Hidden = False
WsA.Range("I:I").EntireColumn.Hidden = False
 
With WsN
    .AutoFilterMode = False
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = 2 To LastLig2
        On Error Resume Next
        Kol.Add CStr(.Range("A" & i).Value), CStr(.Range("A" & i).Value)
        On Error GoTo 0
    Next i
    For i = 1 To Kol.Count
        With WsA
            .AutoFilterMode = False
            LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row
        End With
        .Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)
        Set c = WsA.Range("A1:A" & LastLig1).Find(Kol(i), lookat:=xlWhole)
        If Not c Is Nothing Then
            WsA.Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)
            For Each v In .Range("A2:A" & LastLig2).SpecialCells(xlCellTypeVisible)
                Data1 = vbNullString
                For k = 1 To 9
                    Data1 = Data1 & "_" & .Cells(v.Row, k)
                Next k
                For Each w In WsA.Range("A2:A" & LastLig1).SpecialCells(xlCellTypeVisible)
                    Data2 = vbNullString
                    For k = 1 To 9
                        Data2 = Data2 & "_" & WsA.Cells(w.Row, k)
                    Next k
                    If Data1 = Data2 Then
                        .Range("A" & v.Row).Interior.ColorIndex = 4
                        Exit For
                    Else
                        .Range("A" & v.Row).Interior.ColorIndex = 3
                        .Range("A2:I" & v.Row).SpecialCells(xlCellTypeVisible).Copy WsA.Range("A" & LastLig1 + 1)
                    End If
                Next w
            Next v
            Set c = Nothing
        Else
            .Range("A2:A" & LastLig2).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6
            .Range("A2:I" & LastLig2).SpecialCells(xlCellTypeVisible).Copy WsA.Range("A" & LastLig1 + 1)
        End If
    Next i
    .AutoFilterMode = False
    .Range("I:I").EntireColumn.Hidden = True
End With
 
WsA.AutoFilterMode = False
WsA.Range("I:I").EntireColumn.Hidden = True
 
WbN.Save
WbA.Save
Set WbA = Nothing
Set WbN = Nothing
Set WsA = Nothing
Set WsN = Nothing
 
End Sub

Quelqu'un a une idée??
Merciii d'avance
Saf

**Theze** · 23/11/2010, 17h32

Bonjour,

Voici un code que j'ai écris il y a au moins 3 ou 4 ans et que je ne viens pas de tester (trop fainéant) mais le plus simple, tu colle toutes les lignes des deux feuilles sur une même feuille (ici "Feuil1") puis tu lance la proc. Elle va moulinée pour comparer les lignes les unes aux autres en comparant chaque cellules de chaque ligne. Les lignes en doublons seront colorées (pour mieux les indentifier par la suite) et masquées (pour une copie en fin de proc). Ensuite, les lignes restantes seront copiées dans la feuille "Feuil2".
Adapte les noms de feuille et les colonnes pour définir la plage (qui est ta BD)
De toutes façons, ne fais jamais ce genre de test sur le fichier original.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
 
Sub CopieUnique()
 
Dim Fe As Worksheet
Dim Plage As Range
Dim I As Integer, J As Integer
Dim K As Integer, L As Integer
 
'défini la plage sur les colonnes A à F de la feuille 1, à adapter
With Worksheets("Feuil1")
    Set Plage = .Range(.[A1], .[F65536].End(xlUp))
End With
'compare ligne par ligne et dans ces lignes
'compare cellule par cellule, si les cellules
'sont indentiques, incrémente L, si L est égal
'aux nombre de cellules, les lignes sont identiques
'donc colore les lignes de façon à voir lequelles
'et cache celles-ci
With Plage
'"For I = 2" évite la ligne d'entête sinon mettre 1
For I = 2 To .Rows.Count - 1
    For J = .Rows.Count To I + 1 Step -1
        If .Rows(J).EntireRow.Hidden = False Then
            For K = 1 To .Rows(I).Cells.Count
                If .Rows(I).Cells(K) = _
                .Rows(J).Cells(K) Then
                    L = L + 1
                End If
            Next K
            If L = .Rows(1).Cells.Count Then
                With .Rows(I)
                    .EntireRow.Hidden = True
                    .Interior.ColorIndex = 36
                End With
                With .Rows(J)
                    .EntireRow.Hidden = True
                    .Interior.ColorIndex = 34
                End With
            End If
        End If
        L = 0
    Next J
Next I
End With
 
'se sert de la feuille 2 pour coller les enregistrement uniques
Set Fe = Worksheets("Feuil2")
'copie les lignes visibles dans la nouvelle feuille
Plage.Rows.SpecialCells(xlCellTypeVisible).Copy Fe.[A1]
 
'rend les lignes à nouveau visible
Plage.Rows.EntireRow.Hidden = False
 
Set Fe = Nothing
Set Plage = Nothing
 
End Sub

Hervé.