Microsoft 365 VBA + Listbox doublon

[Xplor]

Bonjour à tous,

Je crée ce post car je suis perdu sur les différentes techniques pour ne pas avoir de doublon dans une List Box.

J'ai un programme ou via les informations rentrées au préalable la listbox va indiquer l'ensemble des données mais avec un design plus agréable qu'une feuille Excel.
Cependant étant donnée que j'ai de nombreux doublons et que la listbox n'est qu'une recopie de certaine colonne de la feuille, il y'a de nombreux doublon qui s'affiche dans celle-ci.

J'aimerai donc avoir votre aide sur une formule permettant de récupérer l'ensemble des données de la feuille mais en évitant d'afficher dans la listbox les doublons.

Pour ce faire et ne pas vous perdre dans le programme j'ai crée un fichier test pour la réalisation de cette fonction vous trouverez dans celui-ci une feuille avec des données et l'userform avec la listbox.

La colonne état et matières ont des doublons mais cela ne sont pas à enlever c'est surtout pour la colonne spec.

Merci d'avance pour votre aide

Voici le code actuel :

Private Sub UserForm_Initialize()


With ListBox1
.ColumnCount = 5
ListBox1.ColumnWidths = "150;180;150;100;120"
.RowSource = Feuil1.Range("A1:E100").Address



End Sub

Cordialement

 

[MP59]

Bonjour Xplor,
Comme tu es en 365 il est possible de créer la liste sans doublons avec la formule unique (avoir avoir mis ta plage en tableau structuré) et de prendre le résultat comme plage (fichier joint).

 

[Xplor]

Bonjour Xplor,
Comme tu es en 365 il est possible de créer la liste sans doublons avec la formule unique (avoir avoir mis ta plage en tableau structuré) et de prendre le résultat comme plage (fichier joint).

Bonjour MP59,

Merci pour cette technique que je pourrais utiliser dans d'autres feuilles excel.
Cependant pour le fichier en question je ne peux pax faire cette technique.

Les données de la feuille dans mon programme sont ajoutés via un userform avec un bouton ajout (L'utilisateur renseigne lui même ses données).
Les données sont directement ajouté sur la feuille je ne sais pas les faire arriver directement dans un tableau.

Il n'y a pas d'autres solutions ?

 

[MP59]

A ma connaissance rien n'empêche un userform d'envoyer des données dans un tableau structuré défini comme tel au départ. Mais je peux me tromper ou avoir mal compris ta question.

 

[JM27]

Bonjour

 

[Xplor]

Bonjour

Bonjour,

Tout d'abord merci à toi pour ton aide.
Malheureusement je n'arrive pas a utiliser ton code via mon fichier.

J'ai changé mon code pour afficher le contenu de ma feuille.
Le voici :


Public Sub SpecListbox()

' affiche le contenu de la lListBox1
Me.ListBoxspec.ColumnCount = 2

Me.ListBoxspec.ColumnWidths = "300,150"
Me.ListBoxspec.Clear
With Sheets("Feuil1")
Set Plage = .Range("B2:C100" & .Range("C" & Rows.Count).End(xlUp).Row)
Me.ListBoxspec.List = Plage.Value
Me.ListBoxspec.ListIndex = 5
Dim i As Integer




End With

End Sub


Via ce code pourrait tu me dire comment supprimer les doublons afficher sur la Listbox par rapport à la ligne C de ma feuille "Feuil1"

Merci d'avance

 

[JM27]

bonjour
tu n'as pas fait du tout comme je te l'ai indiqué
essayes de le comprendre avant de l'appliquer
Ci joint ton code documenté
la collection n'est qu'utile que pour supprimer les doublons

Private Sub UserForm_Initialize()
    ' déclaration de variables
    Dim Collec As New Collection
    Dim cell As Range
    Me.ListBoxspec.ColumnWidths = "300,150"
    Me.ListBoxspec.Clear
    With Sheets("Feuil1")
        ' Pour chaque cellule de la plage A2 à A et dernière ligne
        For Each cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
          ' si une erreur survient , on continue
          On Error Resume Next
          ' On crée une collection de la colonne Spec ( c'est la ou se trouve les valeurs en doublons)
          ' on le charge dans la collection
          ' le collection n'accepte que les valeur uniques , le cas échéant on a une erreur d'ou le on error resume next
          Collec.Add cell.Offset(0, 1), CStr(cell.Offset(0, 1))
          'Si il n'y a pas d'erreur c'est que c'est une valeur unique
          If Err = 0 Then
            ' dans ce cas on charge la list box par la méthode add item
            Me.ListBoxspec.AddItem
            Me.ListBoxspec.List(Me.ListBoxspec.ListCount - 1, 0) = cell
            Me.ListBoxspec.List(Me.ListBoxspec.ListCount - 1, 1) = cell.Offset(0, 1)
          Else
            ' si l'erreur est didfférente de 0 , on la remet à zéro
            Err = 0
          End If
          On Error GoTo 0
        ' l'on passe à la ligne suivante
        Next
    End With
End Sub

 

[Xplor]

Merci pour les explications.

bonjour
tu n'as pas fait du tout comme je te l'ai indiqué
essayes de le comprendre avant de l'appliquer
Ci joint ton code documenté
la collection n'est qu'utile que pour supprimer les doublons

Private Sub UserForm_Initialize()
    ' déclaration de variables
    Dim Collec As New Collection
    Dim cell As Range
    Me.ListBoxspec.ColumnWidths = "300,150"
    Me.ListBoxspec.Clear
    With Sheets("Feuil1")
        ' Pour chaque cellule de la plage A2 à A et dernière ligne
        For Each cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
          ' si une erreur survient , on continue
          On Error Resume Next
          ' On crée une collection de la colonne Spec ( c'est la ou se trouve les valeurs en doublons)
          ' on le charge dans la collection
          ' le collection n'accepte que les valeur uniques , le cas échéant on a une erreur d'ou le on error resume next
          Collec.Add cell.Offset(0, 1), CStr(cell.Offset(0, 1))
          'Si il n'y a pas d'erreur c'est que c'est une valeur unique
          If Err = 0 Then
            ' dans ce cas on charge la list box par la méthode add item
            Me.ListBoxspec.AddItem
            Me.ListBoxspec.List(Me.ListBoxspec.ListCount - 1, 0) = cell
            Me.ListBoxspec.List(Me.ListBoxspec.ListCount - 1, 1) = cell.Offset(0, 1)
          Else
            ' si l'erreur est didfférente de 0 , on la remet à zéro
            Err = 0
          End If
          On Error GoTo 0
        ' l'on passe à la ligne suivante
        Next
    End With
End Sub