Scripting.Dictionary avec doublon

kevenpom

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

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

XLDnaute Barbatruc
Repose en paix
Re : Scripting.Dictionary avec doublon

Bonjour,

Code:
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
 

Pièces jointes

  • ComparaisonFeuilles2.zip
    39.3 KB · Affichages: 56

kevenpom

XLDnaute Junior
Re : Scripting.Dictionary avec doublon

Merci sa marche parfaitement.
Mais jai une question si admetons
Code:
  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.....
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Scripting.Dictionary avec doublon

Comparaison classeurs:

Code:
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
 

Pièces jointes

  • CompareClasseurs.xls
    31.5 KB · Affichages: 65

Discussions similaires

Réponses
2
Affichages
208

Statistiques des forums

Discussions
312 895
Messages
2 093 382
Membres
105 713
dernier inscrit
Karimov