XL 2021 liste valeurs d'un combobox (doublons + tri)

[samuelrollens]

Bonjour,

grâce au code dessous, j'obtiens bien une liste déroulante avec les valeurs de la colonne "Référence utilisateur".
par contre, j'aimerais que les valeurs soient uniques (même si doublons dans la colonne) et qu'elles soient triées
d'avance merci de votre aide
SamuelR

'Initialisation du formulaire avec remplissage du combobox via colonne réf utilisateur
Private Sub UserForm_Initialize()

Dim ws_b As Worksheet
Dim Col_reference_utilisateur As Long
Dim lastRow As Long
Dim i As Long



' Définir la feuille de calcul
Set ws_b = ThisWorkbook.Sheets("Base")

' renvoi le n° de la colonne "Référence utilisateur" pour l'exploiter dans Cells
Col_reference_utilisateur = ws_b.Rows(1).Find("Référence utilisateur", LookAt:=xlWhole).Column

' Trouver la dernière ligne de la colonne col_refuti
lastRow = ws_b.Cells(ws_b.Rows.Count, Col_reference_utilisateur).End(xlUp).Row

' Vider le ComboBox
Combo_reference_utilisateur.Clear

' Remplir le ComboBox avec les valeurs de la colonne col_refuti, en excluant l'en-tête
For i = 2 To lastRow ' Commencer à 2 pour exclure l'en-tête
If ws_b.Cells(i, Col_reference_utilisateur).Value <> "" Then
Combo_reference_utilisateur.AddItem ws_b.Cells(i, Col_reference_utilisateur).Value
End If

Next i

End Sub

 

[fanfan38]

Bonjour et bienvenu sur le forum

' Remplir le ComboBox avec les valeurs de la colonne col_refuti, en excluant l'en-tête
For i = 2 To lastRow ' Commencer à 2 pour exclure l'en-tête
 If ws_b.Cells(i, Col_reference_utilisateur).Value <> "" Then
  Combo_reference_utilisateur=ws_b.Cells(i, Col_reference_utilisateur).Value
  if Combo_reference_utilisateur.listindex=-1 then
    Combo_reference_utilisateur.AddItem ws_b.Cells(i, Col_reference_utilisateur).Value
  endif
 End If
next

A+ François

 

[samuelrollens]

Bonjour et bienvenu sur le forum

' Remplir le ComboBox avec les valeurs de la colonne col_refuti, en excluant l'en-tête
For i = 2 To lastRow ' Commencer à 2 pour exclure l'en-tête
 If ws_b.Cells(i, Col_reference_utilisateur).Value <> "" Then
  Combo_reference_utilisateur=ws_b.Cells(i, Col_reference_utilisateur).Value
  if Combo_reference_utilisateur.listindex=-1 then
    Combo_reference_utilisateur.AddItem ws_b.Cells(i, Col_reference_utilisateur).Value
  endif
 End If
next

A+ François

bonjour François
merci de ton aide
j'ai donc ajouté cette commande
if Combo_reference_utilisateur.listindex=-1 then
Combo_reference_utilisateur.AddItem ws_b.Cells(i, Col_reference_utilisateur).Value

mes valeurs ne sont pas trièes ni dé doublonnées
Samuel

 

[fanfan38]

Un fichier aurait été le bienvenu
cette ligne est aussi importante (pour les doublons)

Combo_reference_utilisateur=ws_b.Cells(i, Col_reference_utilisateur).Value

A+ François

 

[Dranreb]

Bonjour.
Info: J'ai des modules de service (c'est à dire assez costauds mais ne nécessitant aucune maintenance) pour résoudre ce genre de besoins, avec à la clé une programmation applicative courte et simple dans l'UserForm. Mais il me faut votre classeur pour que je puisse les y installer.

 

[bakerman2]

Private Sub UserForm_Initialize()

Dim Col_reference_utilisateur As Long
Dim lastRow As Long
Dim SearchRng As String

' Définir la feuille de calcul
    With ThisWorkbook.Sheets("Base")

' renvoi le n° de la colonne "Référence utilisateur" pour l'exploiter dans Cells
        Col_reference_utilisateur = .Rows(1).Find("Référence utilisateur", LookAt:=xlWhole).Column

' Trouver la dernière ligne de la colonne col_refuti
        lastRow = .Cells(.Rows.Count, Col_reference_utilisateur).End(xlUp).Row

' Remplir le ComboBox avec les valeurs de la colonne col_refuti, en excluant l'en-tête
        SearchRng = .Cells(2, Col_reference_utilisateur).Resize(lastRow - 1).Address
        Combo_reference_utilisateur.List = .Evaluate("Sort(Unique(Filter(" & SearchRng & "," & SearchRng & "<>"""")),,1)")
    End With
End Sub

 

[Cousinhub]

Bonjour,
En utilisant un Tableau Structuré, en une ligne de code pour alimenter le Combo trié sans doublons.
Compatible pour les versions à partir de 2021
Bonne fin d'apm
Edit, oups, et j'allais oublier, merci @mapomme pour ce code

 

[fanch55]

Private Sub UserForm_Initialize()

Dim Col_reference_utilisateur As Long
Dim lastRow As Long
Dim SearchRng As String

' Définir la feuille de calcul
    With ThisWorkbook.Sheets("Base")

' renvoi le n° de la colonne "Référence utilisateur" pour l'exploiter dans Cells
        Col_reference_utilisateur = .Rows(1).Find("Référence utilisateur", LookAt:=xlWhole).Column

' Trouver la dernière ligne de la colonne col_refuti
        lastRow = .Cells(.Rows.Count, Col_reference_utilisateur).End(xlUp).Row

' Remplir le ComboBox avec les valeurs de la colonne col_refuti, en excluant l'en-tête
        SearchRng = .Cells(2, Col_reference_utilisateur).Resize(lastRow - 1).Address
        Combo_reference_utilisateur.List = .Evaluate("Sort(Unique(Filter(" & SearchRng & "," & SearchRng & "<>"""")),,1)")
    End With
End Sub

Intéressant l'"Evaluate(Sort" à condition que les données soient numériques ou strictement alphabétiques

 

[job75]

Bonjour le forum,

Intéressant l'"Evaluate(Sort" à condition que les données soient numériques ou strictement alphabétiques

Oui avec le fichier de Cousinhub le tri alphabétique des jours ne va pas.

De plus chez moi sur Excel 2019 les fonctions Unique et Filter sont inconnues, j'utilise donc :

Private Sub UserForm_Initialize()
Dim memo
Application.ScreenUpdating = False
With [T_Data] 'tableau structuré
    memo = .Value 'mémorise
    .Columns(2) = "=WEEKDAY(RC[-1],2)"
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri
    .RemoveDuplicates 2, Header:=xlNo 'supprime les doublons
    .Columns(2) = "=IF(ISNUMBER(RC[-1]),TEXT(RC[-1],""jjjj""),0)" 'pour version française
    On Error Resume Next 'si aucune SpecialCell
    Combo_reference_utilisateur.List = .Columns(2).SpecialCells(xlCellTypeFormulas, 2).Resize(, 2).Value
    .Value = memo 'état initial
End With
Application.ScreenUpdating = True
End Sub

A+

 

[Cousinhub]

Bonjour,

Bonjour le forum,

Oui avec le fichier de Cousinhub le tri alphabétique des jours ne va pas.

🧐🤓

Peut-être confonds-tu tri "alphabétique" avec tri "chronologique"?

Dans ton code, le tri est effectué par cette liste :

Bon dimanche

 

[fanch55]

Bonjour le forum,
De plus chez moi sur Excel 2019 les fonctions Unique et Filter sont inconnues, j'utilise donc :

Salut @job, en lisant les articles, le Sort n'est disponible qu'à partir de Xl 2021 .
Je dois avouer que même en étant sous Office 2024, j'oublie les fonctions Sort et Filter .

 

[Cousinhub]

RE-,
Je viens de relire ce fil, et un doute m'habite...

Tu affirmes :

Oui avec le fichier de Cousinhub le tri alphabétique des jours ne va pas.

Puis tu affirmes, de nouveau :

De plus chez moi sur Excel 2019 les fonctions Unique et Filter sont inconnues, j'utilise donc :

Comment as-tu pu détecter que le tri n'était pas le bon? 🙂
Bonne soirée

 

[job75]

Comment as-tu pu détecter que le tri n'était pas le bon? 🙂

En effet je n'ai pas pu tester.

Mais a priori tu tries des textes (les noms des jours), alors qu'il faut trier des nombres pour avoir un tri chronologique.

 

[job75]

Bonjour le forum,

Quelques améliorations dans le fichier joint.

J'ai complété la 1ère formule et laissé en place la 2ème formule en colonne B :

Private Sub UserForm_Initialize()
Dim memo
Application.ScreenUpdating = False
With [T_Data] 'tableau structuré
    memo = .Columns(1) 'mémorise la colonne A
    .Columns(2) = "=IF(ISNUMBER(RC[-1]),WEEKDAY(RC[-1],2),0)"
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri
    .RemoveDuplicates 2, Header:=xlNo 'supprime les doublons
    .Columns(2) = "=IF(ISNUMBER(RC[-1]),TEXT(RC[-1],""jjjj""),0)" 'pour version française
    On Error Resume Next 'si aucune SpecialCell
    Combo_reference_utilisateur.List = .Columns(2).SpecialCells(xlCellTypeFormulas, 2).Resize(, 2).Value
    .Columns(1) = memo 'état initial
End With
Application.ScreenUpdating = True
End Sub

Pour masquer les valeurs zéro la colonne B est mise au format Standard;;

A+

 

[job75]

Avec la liste déroulée :

Private Sub UserForm_Initialize()
Dim memo
Application.ScreenUpdating = False
With [T_Data] 'tableau structuré
    memo = .Columns(1) 'mémorise la colonne A
    .Columns(2) = "=IF(ISNUMBER(RC[-1]),WEEKDAY(RC[-1],2),0)"
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri
    .RemoveDuplicates 2, Header:=xlNo 'supprime les doublons
    .Columns(2) = "=IF(ISNUMBER(RC[-1]),TEXT(RC[-1],""jjjj""),0)" 'pour version française
    On Error Resume Next 'si aucune SpecialCell
    Combo_reference_utilisateur.List = .Columns(2).SpecialCells(xlCellTypeFormulas, 2).Resize(, 2).Value
    .Columns(1) = memo 'état initial
End With
Application.ScreenUpdating = True
CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
End Sub

Edit : chez moi sur Windows 11 Application.ScreenUpdating = True n'est pas nécessaire mais l'est peut-être sur les versions antérieures.