[VBA] - Dictionnaire sans doublons

Bonsoir,

Je ne parviens pas à faire en sorte que mon dictionnaire ne comporte aucun doublon...

Au final lorsque je veux lister les données uniques, je me retrouve avec x fois la même donnée.

Sur quoi est-ce que je me trompe d'après vous ?

Dim bi As Worksheet, dc As Worksheet
Dim Dico
Dim tabDep As Variant
Dim lrdc&
Dim a%, cib0%, cib1%

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bi = Worksheets("CNPN (Bilan impacts)")
Set dc = Worksheets("Données Collector")
Set Dico = CreateObject("Scripting.dictionary")

'Compter le nombre d'impacts
dc.Select
With dc
cib0 = dc.Rows("1:1").Find("NUM_IMPCT", LookIn:=xlValues, lookat:=xlWhole).Column
cib1 = dc.Rows("1:1").Find("TYP_IMPCT", LookIn:=xlValues, lookat:=xlWhole).Column
Max = Application.WorksheetFunction.Max(Columns(cib0))
lrdc = dc.Cells(Rows.Count, 2).End(xlUp).Row

tabDep = .Range(Cells(2, cib1), Cells(lrdc, cib1))

'création collection
b = 1
On Error Resume Next
    For Each i In tabDep
        If i <> "" Then
            If Not Dico.Exists(i) Then
            Dico.Add b, i
            b = b + 1
            End If
        End If
    Next i
'On Error GoTo 0
End With

'export collection dans resultat
bi.Select
With bi
.Cells(1, 2) = "Nature des Impacts"
    For a = 2 To Max + 1
        If Dico.Count > 0 Then
            'If Dico(a) <> bi.Cells(2, a - 1) Then
                bi.Cells(2, a) = Dico(a)
            'End If
        End If
    Next a

.Cells(1, Max + 2) = "Evaluation globale de l'impact"
.Range(Cells(1, Max + 2), Cells(2, Max + 2)).Merge
.Range(Cells(1, 2), Cells(1, Max + 1)).Merge

End With

Je joins un document Excel pour mieux illustrer ma requête

Bonne soirée !

Pas de fichier joint :/

Bonjour,

Il y a peut être un pb de casse. Exemple.

Sub ListeSansDoublons()
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare
  For Each c In Range("a2", [a65000].End(xlUp))
    d(c.Value) = ""
  Next c
  [c2].Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub

Boisgontier

Bonjour,

Merci beaucoup pour votre aide ! C'est quasiment le résultat que j'espérais, à un détail près ! Actuellement la fonction transpose liste les résultats dans une colonne et je ne parviens pas à faire en sorte qu'elle se fasse sur une ligne.

J'ai essayé avec ma logique puis en cherchant sur le forum (ici par exemple : https://forum.excel-pratique.com/viewtopic.php?t=95080 )

Voici le code que j'ai pour le moment :

Dim c As Variant
Dim col%, lig%, i%
Dim d
Set bi = Worksheets("CNPN (Bilan impacts)")
Set dc = Worksheets("Données Collector")
Set d = CreateObject("Scripting.Dictionary")

    d.CompareMode = vbTextCompare
    cib1 = dc.Rows("1:1").Find("TYP_IMPCT", LookIn:=xlValues, lookat:=xlWhole).Column
    lrdc = dc.Cells(Rows.Count, 2).End(xlUp).Row

    With dc
      For Each c In .Range(.Cells(2, cib1), .Cells(lrdc, cib1)) '("a2", [a65000].End(xlUp))
        If c <> "" Then
            d(c.Value) = ""
        End If
      Next c
    End With
With bi
    col = 2
    lig = 2
    For i = 1 To d.Count
        .Cells(lig, col) = Application.Transpose(d.keys)
        col = col + 1
    Next i
 ' .Rows(2).Resize(d.Count, 1) = Application.Transpose(d.keys)
End With

Il liste 3 fois la première clé du dictionnaire, sur la bonne ligne.

Mais je ne sais pas comment tout lister.

Peut-être faut-il que je transpose après que les données aient été écrites dans le tableur ?

Bonjour,

Pour lister sur une ligne:

Sub ListeSansDoublons()
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare
  For Each c In Range("a2", [a65000].End(xlUp))
    d(c.Value) = ""
  Next c
  [c2].Resize(1, d.Count) = d.keys
End Sub

Boisgontier

Bonsoir,

J'étais vraiment parti loin, alors que la solution était si simple...

Merci pour votre aide !

C'est un code que j'aurais du trouver directement sur votre site.

Bonne soirée !