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 tableau_comparaison()
Dim Cel As Range
Dim J As Long, NbLg As Long, Ligne As Long
Dim F1 As Worksheet, F2 As Worksheet
Dim I As Integer
Dim Colonnes
Dim LigneCopie As Boolean
Application.ScreenUpdating = False
Set F1 = Sheets("Tableau")
Colonnes = Array("U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN") 'les colonnes que je voulais comparer (tableau1)
Set F2 = Sheets("Tableau")
Colonnes = Array("AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH") 'les colonnes que je voulais comparer (tableau2)
Cells.Clear ' On efface la page réception
Ligne = 5 'Ma première ligne
With F1
.Rows(1).Copy Range("U5") ' La ligne des entêtes
NbLg = .Range("A" & Rows.Count).End(xlUp).Row
For J = 21 To NbLg
LigneCopie = False
' Recherche de l'ID de la feuille 1 dans la feuille 2
Set Cel = F2.Columns("A").Find(what:=.Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
' On a trouvé l'ID
F2.Range("X" & Cel.Row) = "X" ' On note ligne vue : Sens F1 vers F2
For I = 0 To UBound(Colonnes) ' On passe en revue toutes les colonnes
If F2.Range(Colonnes(I) & Cel.Row) <> .Range(Colonnes(I) & J) Then ' Différence
If LigneCopie = False Then ' La ligne a été copiée
Ligne = Ligne + 1 ' Non donc on passe à la ligne suivante
F2.Rows(Cel.Row).Copy Range("A" & Ligne) ' Copie la ligne de la feuille 2
Range("X" & Ligne) = "Modifiée"
LigneCopie = True ' On indique que la ligne a été copiée
End If
Range(Colonnes(I) & Ligne).Interior.ColorIndex = 3 ' On colorise les cellules différentes
End If
Next I ' Colonne suivante
Else
' ID non trouvée
Ligne = Ligne + 1 ' On passe à la ligne suivante
F1.Rows(J).Copy Range("A" & Ligne) ' Copie la ligne de la feuille 1
Range("X" & Ligne) = "Supprimée"
End If
Next J ' On passe à la ligne suivante
End With
With F2
NbLg = .Range("A" & Rows.Count).End(xlUp).Row
For J = 2 To NbLg
If .Range("X" & J) = "" Then ' Ligne non vue donc nouvelle
Ligne = Ligne + 1 ' On passe à la ligne suivante
.Rows(J).Copy Range("A" & Ligne) ' Copie la ligne de la feuille 2
Range("X" & Ligne) = "Nouvelle"
End If
Next J
End Sub |
