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 |
Partager