alimenter listbox sans ligne identique

[dam3117]

Bonjour,

j'ai trois colonnes:
colonne A: DATE
colonne B: NOM
colonne C: TYPE

Je veux alimenter ma listbox1 avec les trois colonnes mais qu'il me supprime les lignes identiques.

exemple même date, même nom, même type 3 fois dans mon tableau => une seule ligne dans ma listbox.

cdt
dam3117

 

[Robert]

Re : alimenter listbox sans ligne identique

Bonjour Dam, bonjour le forum,

Tu aurais pu (même dû) mettre un petit fichier exemple ça nous aurait évité de le faire. Dailleurs si tu n'as pas eu de réponse plus vite c'est certainement à cause de ça... Un coup d'œil à la Lien supprimé te ferait le plus grand bien...
Une solution un peu tirée par les cheveux... Il doit y avoir beaucoup plus simple mais je n'ai pas trouvé mieux. le code que je te propose utilise la colonne D en y plaçant des données puis en les effaçants. Donc fait attention si ton tableau comporte des données en D...
le code :

Private Sub UserForm_Initialize() 'à l'intialisation de l'UserForm
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim r As Range 'déclare la variable r (Recherche)

Application.ScreenUpdating = False 'masque les changements àl'écran
With Sheets("Feuil1") 'prned en compte l'onglet "Feuil1"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'de'finit la dernière ligne édité dl de la colonne A
    Set pl = .Range("A2:A" & dl) 'définit la plage pl (colonne A)
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        'concatene en colonne D les 3 cellules des colonne A, B et C
        cel.Offset(0, 3).Value = cel.Value & cel.Offset(0, 1).Value & cel.Offset(0, 2).Value
    Next cel 'prochaine cellule de la plage pl
    Set pl = pl.Offset(0, 3) 'redéfinit la plage pl (colonne D)
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        If cel.Interior.ColorIndex <> 3 Then 'condition : si la cellule n'est pas colorée de rouge
            pa = cel.Address 'définit l'adresse de la première occurrence trouvée pa
            Set r = pl.Find(cel.Value, cel, xlValues, xlWhole) 'définit la recherche r
            If Not r Is Nothing And r.Address < pa Then 'condition 2 : si il existe d'autre accurrences ailleurs qu'en pa
                Do 'exécute
                    r.Interior.ColorIndex = 3 'colore la cellule de rouge
                    Set r = pl.FindNext(r) 'redéfinit la recherche (occurrence suivante)
                Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next cel 'prochaine cellule de la boucle
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        If cel.Interior.ColorIndex <> 3 Then 'condition : si la cellule n'est pas colorée de rouge
            With Me.ListBox1 'prend en compte la ListBox1
                .AddItem cel.Offset(0, -3).Value 'ajoute la valeur de la colonne A
                .Column(1, .ListCount - 1) = cel.Offset(0, -2).Value 'ajoute la valeur de la colonne B
                .Column(2, .ListCount - 1) = cel.Offset(0, -1).Value 'ajoute la valeur de la colonne C
            End With 'fin de la prise en compte de la ListBox1
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle
    .Columns(4).Clear 'efface la colonne D
End With 'fin de la prise en compte de l'onglet "Feuil1"
Application.ScreenUpdating = True 'affiche les changements àl'écran
End Sub

Le fichier :

 

[tototiti2008]

Re : alimenter listbox sans ligne identique

Bonjour dam, Bonjour Robert ,

Sur la base du travail de Robert, et applicable sur son fichier, avec un dictionnaire

Private Sub UserForm_Initialize()
Dim Valeurs 'tableau des valeurs de A1 à c28
Dim lig As Long 'numéro de ligne des valeurs récupérées
Dim assoc As String 'Association des valeurs des 3 colonnes pour former un identifiant
Dim Dico 'dictionnaire servant à supprimer les doublons
Dim Sep 'Valeurs des 3 colonnes séparées après suppression doublons
    'création dictionnaire
    Set Dico = CreateObject("Scripting.Dictionary")
    'stockage des données dans la variable Valeurs
    Valeurs = Sheets("Feuil1").Range("A1").CurrentRegion.Value
    'Pour chaque ligne de valeur récupérée après la ligne de titre
    For lig = LBound(Valeurs, 1) + 1 To UBound(Valeurs, 1)
        'création de l'identifiant de la ligne
        assoc = Valeurs(lig, 1) & "µ" & Valeurs(lig, 2) & "µ" & Valeurs(lig, 3)
        'ajout de l'identifiant au dictionnaire
        Dico(assoc) = assoc
    Next lig
    'récupération des données sans doublons
    Valeurs = Dico.keys
    'alimentation de la listbox
    ListBox1.Clear
    'Pour chaque ligne sans doublon obtenue
    For lig = LBound(Valeurs) To UBound(Valeurs)
        'On sépare les données du dictionnaire
        Sep = Split(Valeurs(lig), "µ")
        'On ajoute les données à la listebox
        With ListBox1
            .AddItem Sep(0)
            .Column(1, .ListCount - 1) = Sep(1)
            .Column(2, .ListCount - 1) = Sep(2)
        End With
    Next lig
End Sub

A noter que cette version ne met pas les lignes en couleur

Edit : à noter que j'ai fait l'effort d'essayer de commenter comme le fait systématiquement notre ami Robert, vais essayer de continuer à l'avenir

 

[Robert]

Re : alimenter listbox sans ligne identique

Bonsoir Dam, Tototiti, bonsoir le forum,

J'suis vert... Comment n'y ai pas pensé ! Doré de l'avant appelez-moi RoVert...