XL 2019 Dico qui garde les doublons

carlos

XLDnaute Impliqué
Supporter XLD
Bonjour,
Vous pourrez peut etre m'aider.
Exemple en PJ.
Je ne comprends pas pourquoi les doublons ne sont pas exclus du dico dans un premier temps, ni pourquoi les valeurs du dico ne sont pas collés en colonne C dans un second temps.
Merci our votre aide
 

Pièces jointes

  • Dico sans doublon.xlsm
    24 KB · Affichages: 3
Solution
Bonjour Carlos,
Vous re déclarez votre dictionnaire à chaque cellule analysée.
VB:
  For Each Cell In Feuil1.Range("b2:b" & Feuil1.Range("B6500").End(xlUp).Row) 'classes
        Set DICO4 = CreateObject("Scripting.Dictionary") 'ON CHERCHE LES CLASSES
il suffit de le déclarer une seule fois en début de macro :
Code:
Set DICO4 = CreateObject("Scripting.Dictionary") 'ON CHERCHE LES CLASSES
For Each Cell In Feuil1.Range("b2:b" & Feuil1.Range("B6500").End(xlUp).Row) 'classes
1709797183923.png

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Carlos,
Vous re déclarez votre dictionnaire à chaque cellule analysée.
VB:
  For Each Cell In Feuil1.Range("b2:b" & Feuil1.Range("B6500").End(xlUp).Row) 'classes
        Set DICO4 = CreateObject("Scripting.Dictionary") 'ON CHERCHE LES CLASSES
il suffit de le déclarer une seule fois en début de macro :
Code:
Set DICO4 = CreateObject("Scripting.Dictionary") 'ON CHERCHE LES CLASSES
For Each Cell In Feuil1.Range("b2:b" & Feuil1.Range("B6500").End(xlUp).Row) 'classes
1709797183923.png
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @carlos :),

Vous avez placé la création du dictionnaire dans la boucle de remplissage de dico.
Donc à chaque fois que vous passez dans la boucle, vous repartez de zéro (recréation de dico, le jour forcément n'existe pas, donc on le rajoute et ainsi de suite). A la fin, vous n'aurez qu'un seul jour dans votre dico, le dernier jour de la plage.
En revanche la constitution de la chaine Test est indépendante du dico. C'est pourquoi tous les jours s'y retrouvent.
Placez la création du dictionary avant la boucle de lecture.

Edit: bonjour @sylvanu :), j'avions pas rafraichi :oops:!

VB:
Private Sub CommandButton1_Click()
Dim C As Range, DICO4, R, ZA, cell, i As Long
  
   Set DICO4 = CreateObject("Scripting.Dictionary")
   For Each cell In Feuil1.Range("b2:b" & Feuil1.Cells(Rows.Count, "b").End(xlUp).Row)
      ZA = cell.Value
      If ZA <> "" Then DICO4(ZA) = ""
   Next cell
  
   Application.ScreenUpdating = False
   ReDim t(1 To DICO4.Count, 1 To 1)
   For Each R In DICO4.keys: i = i + 1: t(i, 1) = R: Next
   Feuil1.Range("C:C").ClearContents
   Feuil1.Cells(Rows.Count, "c").End(xlUp).Offset(1).Resize(DICO4.Count) = t
End Sub
 
Dernière édition:

Statistiques des forums

Discussions
312 207
Messages
2 086 250
Membres
103 165
dernier inscrit
thithithi78