Sub ShareCat_Status()
Dim Derlig1 As Long, Derlig2 As Long
Dim Cptr As Integer, T1_colb(), T2_colb
Dim Dico1 As Object, Dico2 As Object
'fige le défilement de l'écran
Application.ScreenUpdating = False
With Sheets("ShareCat Extract")
'initialisation et préparation feuil2
Derlig2 = .Cells(.Rows.Count, 4).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(Derlig2, 4)).Interior.ColorIndex = xlNone
'passage en ram tableau feuil2
T2_colb = .Range(.Cells(1, 1), .Cells(Derlig2, 9)).Value
'création du dictionnary feuille1 col b
Set Dico2 = CreateObject("scripting.dictionary")
For Cptr = 6 To UBound(T2_colb)
If Not Dico2.exists(T2_colb(Cptr, 4)) Then 'élimination des éventuels doublons
Dico2.Add T2_colb(Cptr, 4), T2_colb(Cptr, 9)
End If
Next
End With
'préparations feuil1
With Sheets("Master Register")
Derlig1 = .Cells(.Rows.Count, 1).End(xlUp).Row
'passage en ram tableau feuille1
T1_colb = .Range(.Cells(1, 1), .Cells(Derlig1, 1)).Value
'création du dictionnary feuille1 col b
Set Dico1 = CreateObject("scripting.dictionary")
For Cptr = 3 To UBound(T1_colb)
If Not Dico1.exists(T1_colb(Cptr, 1)) Then 'élimination des éventuels doublons
Dico1.Add T1_colb(Cptr, 1), ""
End If
Next
'détecte les éléments de feuil2 manquant en feuil1 _
et les colorise en jaune
For Cptr = 3 To UBound(T1_colb)
If Dico2.exists(T1_colb(Cptr, 1)) Then
.Range(.Cells(Cptr, 2), .Cells(Cptr, 2)).Value = Dico2.Item(T1_colb(Cptr, 1))
Else
.Range(.Cells(Cptr, 2), .Cells(Cptr, 2)).Value = "Not Created"
End If
Next
End With
Set Dico1 = Nothing
Set Dico2 = Nothing
End Sub