Scripting.Dictionary avec doublon

[kevenpom]

Bonjours Forum comment allez-vous
J'aurait une petite question auquelle je ne trouve pas de réponse...
Jai une parti de code

 f1 = 3  'no feuille
 f2 = 5
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("temp").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "temp"
    Sheets(f1).Activate
    Set Execut = CreateObject("Scripting.Dictionary")
    Set ListeFu = CreateObject("Scripting.Dictionary")
    For Each c In Sheets(f1).Range("B:B").SpecialCells(xlCellTypeConstants, 23)
      If Not Execut.Exists(c.Value) Then Execut.Add c.Value, c.Address
    Next
    '---
    Sheets(f2).Activate
    For Each c In Sheets(f2).Range("A:A").SpecialCells(xlCellTypeConstants, 23)
      If Not ListeFu.Exists(c.Value) Then ListeFu.Add c.Value, c.Address
    Next
    '---
    I = 1
    Sheets(f1).Activate
    For Each e In Execut
       If ListeFu.Exists(e) Then
         Range(Execut.Item(e)).Interior.ColorIndex = 4
       Else
       Range(Execut.Item(e)).Interior.ColorIndex = 6
         I = I + 1
         Sheets("temp").Cells(I, 2) = e
         Sheets("temp").Cells(I, 1) = Execut.Item(e)
       End If
    Next

Sa me sert a faire une comparaison de tableau exemple si un numéro apparait dans les 2 feuilles bien il est de couleur verte sinon il est jaune
Mais voila comment faire pour qu'il prennent toute mes doublons de ma feuille1 en considération...

merci d'avance

 

[BOISGONTIER]

Re : Scripting.Dictionary avec doublon

Bonjour,

Sub Essai()
 f1 = 1
 f2 = 2
 Application.DisplayAlerts = False
 On Error Resume Next
 Sheets("temp").Delete
 Sheets.Add after:=Sheets(Sheets.Count)
 ActiveSheet.Name = "temp"
 i = 1
 For Each c In Sheets(f1).Range("A1:B5000").SpecialCells(xlCellTypeConstants, 23)
   If Sheets(f2).Range("A1:B5000").Find(c, LookAt:=xlWhole) Is Nothing Then
    c.Font.Color = vbRed
    i = i + 1
    Sheets("temp").Cells(i, 2) = c.Address
    Sheets("temp").Cells(i, 1) = c
   Else
    c.Font.Color = vbBlack
   End If
Next
End Sub

JB
Formation Excel VBA JB

 

[kevenpom]

Re : Scripting.Dictionary avec doublon

Merci sa marche parfaitement.
Mais jai une question si admetons

  Chemin = ThisWorkbook.Path ' même dossier
 ' Chemin = "D:\keven\désuetude\bd.xls" 'a mettre
 Workbooks.Open Chemin & "\fu.xls"
        With ActiveWorkbook
        With .Worksheets("feuil1")
            TabFu = .Range("A1:A" & .Range("A65536").End(xlUp).Row).Value
        End With
   .Close
        End With

JE VOUDRAIT comparer ma premiere feuille avec mon TABFU comment procédé.
toujour avec ton code.....

 

[BOISGONTIER]

Re : Scripting.Dictionary avec doublon

Comparaison classeurs:

Sub Essai()
 Set Champ1 = Workbooks("CompareClasseurs.xls").Sheets(1).Range("A1:B5000")
 Set Champ2 = Workbooks("CompareClasseurs2.xls").Sheets(1).Range("A1:B5000")
 Application.DisplayAlerts = False
 On Error Resume Next
 Sheets("temp").Delete
 Sheets.Add after:=Sheets(Sheets.Count)
 ActiveSheet.Name = "temp"
 i = 1
 For Each c In champ1.SpecialCells(xlCellTypeConstants, 23)
   If Champ2.Find(c, LookAt:=xlWhole) Is Nothing Then
    c.Font.Color = vbRed
    i = i + 1
    Sheets("temp").Cells(i, 2) = c.Address
    Sheets("temp").Cells(i, 1) = c
   Else
    c.Font.Color = vbBlack
   End If
Next
End Sub

JB