Microsoft 365 Doublons dans combobox

M

Marvin57

XLDnaute Occasionnel
Bonjour à tout le monde,

je vous joins un fichier dans lequel j'aurai besoin de votre aide S'il vous plaît.

A partir de l'onglet "STOCK" je peux appeler le UserForm "TRIER_STOCK".
Sur celui-ci, j'aimerai à l'aide du combobox pouvoir choisir les noms du tableau "Tab_1" colonne "A" de l'onglet "STOCK", sans avoir le même nom plusieurs fois.
En cliquant sur filtrer, il devrait me filtrer le nom choisi ainsi que les tarifs et les copier dans le tableau de l'onglet "TRIER STOCK"

Pourriez-vous me modifier le code placé dans le UserForm afin que je n'ai pas de doublons. Ce code me servait dans un ancien fichier, mais je n'arrive pas à le modifier.

Merci d'avance à vous.

Marvin57
 

Pièces jointes

  • Classeur1.xlsm
    19 KB · Affichages: 4
Solution
mapomme
Bonjour à tous,

Une autre version dans le fichier joint.
VB: 
Private Sub UserForm_Initialize()
Dim x, i&, ech As Boolean

   ReDim t(1 To 1)      'On ôte les doublons
   For Each x In Sheets("Stock").Range("a1").ListObject.ListColumns(1).DataBodyRange
      ComboBox1.Text = x
      If ComboBox1.ListIndex = -1 Then
         If ComboBox1.ListCount <> 0 Then ReDim Preserve t(1 To UBound(t) + 1)
         ComboBox1.AddItem x: t(UBound(t)) = x
      End If
   Next x
   If ComboBox1.ListCount >= 2 Then    'On trie les items du combobox1
      Do
         DoEvents
         ech = False
         For i = 1 To UBound(t) - 1
            If t(i + 1) < t(i) Then ech = True: x = t(i): t(i) = t(i + 1): t(i + 1) = x
         Next i
      Loop Until ech =...
Trier par date Trier par votes
M

Marvin57

XLDnaute Occasionnel
Dranreb à dit:
Bonjour.
Ma solution.
Cliquez pour agrandir...
bonjour Dranreb,

Merci d'avoir investit autant de temps pour ma demande. Certes je vois que cela fonctionne très bien. Mais dans mon fichier réel il m'est impossible de placer tous tes codes en plus.

Alors j'ai essayé avec ce que j'avais sous les yeux et j'ai trouvé une solution. Après plusieurs tests, je vois que cela fonctionne.

Voici le code " Private Sub Initialize" de mon fichier réel:

J'ai simplement rajouté un bout de code existant une seconde fois et modifié lesnoms.
mon rajout est en gras.

Private Sub UserForm_Initialize()
Dim i%


TextBox11.Value = Sheets("VALEURS RAYONS STOCK").Range("C20").Value
TextBox13.Value = Sheets("MOUVEMENTS").Range("F2").Value
TextBox14.Value = Sheets("MOUVEMENTS").Range("I2").Value
TextBox15.Value = Sheets("MOUVEMENTS").Range("L2").Value
TextBox24.Value = Sheets("TRIER STOCK").Range("N1").Value

TextBox16.Value = Sheets("STOCK").Range("V3").Value
TextBox17.Value = Sheets("STOCK").Range("U4").Value
TextBox26.Value = Sheets("STOCK").Range("W3").Value
TextBox25.Value = Sheets("CDE").Range("R1").Value
TextBox22.Value = Sheets("CDE").Range("L1").Value
TextBox23.Value = Sheets("CDE").Range("O1").Value

TextBox5 = Format(TextBox5, "#,###,##0.00 €")
TextBox11 = Format(TextBox11, "#,###,##0.00 €")
TextBox12 = Format(TextBox12, "#,###,##0.00 €")
TextBox13 = Format(TextBox13, "#,###,##0.00 €")
TextBox14 = Format(TextBox14, "#,###,##0.00 €")
TextBox15 = Format(TextBox15, "#,###,##0.00 €")
TextBox24 = Format(TextBox24, "#,###,##0.00 €")

With [Tab_1[Rayons]]
For i = 1 To .Rows.Count
ComboBox10 = .Item(i, 1)
'...et filtre les doublons
If ComboBox10.ListIndex = -1 Then ComboBox10.AddItem .Item(i, 1)
Next i
End With

ComboBox10.ListIndex = -1

With [Tab_1[Rayons]]
For i = 1 To .Rows.Count
ComboBox11 = .Item(i, 1)
'...et filtre les doublons
If ComboBox11.ListIndex = -1 Then ComboBox11.AddItem .Item(i, 1)
Next i
End With

ComboBox11.ListIndex = -1

Nettoie
Tri_Stock
ReIndex_ID
InitListBox


'Ote la croix de l'userform - Code Option Explicit dans module MOT_DE_PASSE
OteCroix Me.Caption
End Sub

Dites moi si cela parait correct à vos yeux SVP.

Merci d'avance
Marvin57
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Une autre version dans le fichier joint.
VB: 
Private Sub UserForm_Initialize()
Dim x, i&, ech As Boolean

   ReDim t(1 To 1)      'On ôte les doublons
   For Each x In Sheets("Stock").Range("a1").ListObject.ListColumns(1).DataBodyRange
      ComboBox1.Text = x
      If ComboBox1.ListIndex = -1 Then
         If ComboBox1.ListCount <> 0 Then ReDim Preserve t(1 To UBound(t) + 1)
         ComboBox1.AddItem x: t(UBound(t)) = x
      End If
   Next x
   If ComboBox1.ListCount >= 2 Then    'On trie les items du combobox1
      Do
         DoEvents
         ech = False
         For i = 1 To UBound(t) - 1
            If t(i + 1) < t(i) Then ech = True: x = t(i): t(i) = t(i + 1): t(i + 1) = x
         Next i
      Loop Until ech = False
      ComboBox1.List = t
   End If
End Sub

Private Sub CommandButton1_Click()
Dim t, ref, i&, n&

   'dans le tableau t des valeurs du tableau de la feuille STOCK,
   'on regroupe les lignes répondant au critère choisi de combobox1 en haut du tableau
   If ComboBox1.ListIndex = -1 Then ref = "" Else ref = ComboBox1.List(ComboBox1.ListIndex)
   t = Sheets("Stock").Range("a1").ListObject.DataBodyRange
   If ref <> "" Then
      For i = 1 To UBound(t)
         If t(i, 1) = ref Then n = n + 1: t(n, 1) = t(i, 1): t(n, 2) = t(i, 2)
      Next i
   Else
      n = UBound(t)
   End If
   'on transfère dans le tableau de la feuille TRIER STOCK le "haut" du tableau t
   Application.Goto Sheets("TRIER STOCK").Range("a1"), True
   With Sheets("TRIER STOCK").Range("a1").ListObject
      If .ListRows.Count > 0 Then .DataBodyRange.Delete
      For i = 1 To n: .ListRows.Add: Next
      .DataBodyRange = t
   End With
End Sub
 

Pièces jointes

  • Marvin57- list sans doublon & filtrage- v1.xlsm
    26.8 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
Solution
Dranreb

Dranreb

XLDnaute Barbatruc
Marvin57 à dit:
dans mon fichier réel il m'est impossible de placer tous tes codes en plus.
Cliquez pour agrandir...
Pourquoi ?

Avec un Sujet renvoyé par la fonction SujetCBx du module de service MSujetCBx, pas besoin de refiltrer la base derrière: l'élément Suj(0) contient la liste des clés classée et sans doublon à affecter à la ComboBox1.List et Suj(1) contient les listes de numéros de lignes pour toutes les valeurs possibles où ces clés ont été trouvées dans la base.
 
Vote positif 0 Vote négatif
M

Marvin57

XLDnaute Occasionnel
mapomme à dit:
Bonjour à tous,

Une autre version dans le fichier joint.
VB: 
Private Sub UserForm_Initialize()
Dim x, i&, ech As Boolean

   ReDim t(1 To 1)      'On ôte les doublons
   For Each x In Sheets("Stock").Range("a1").ListObject.ListColumns(1).DataBodyRange
      ComboBox1.Text = x
      If ComboBox1.ListIndex = -1 Then
         If ComboBox1.ListCount <> 0 Then ReDim Preserve t(1 To UBound(t) + 1)
         ComboBox1.AddItem x: t(UBound(t)) = x
      End If
   Next x
   If ComboBox1.ListCount >= 2 Then    'On trie les items du combobox1
      Do
         DoEvents
         ech = False
         For i = 1 To UBound(t) - 1
            If t(i + 1) < t(i) Then ech = True: x = t(i): t(i) = t(i + 1): t(i + 1) = x
         Next i
      Loop Until ech = False
      ComboBox1.List = t
   End If
End Sub

Private Sub CommandButton1_Click()
Dim t, ref, i&, n&

   'dans le tableau t des valeurs du tableau de la feuille STOCK,
   'on regroupe les lignes répondant au critère choisi de combobox1 en haut du tableau
   If ComboBox1.ListIndex = -1 Then ref = "" Else ref = ComboBox1.List(ComboBox1.ListIndex)
   t = Sheets("Stock").Range("a1").ListObject.DataBodyRange
   If ref <> "" Then
      For i = 1 To UBound(t)
         If t(i, 1) = ref Then n = n + 1: t(n, 1) = t(i, 1): t(n, 2) = t(i, 2)
      Next i
   Else
      n = UBound(t)
   End If
   'on transfère dans le tableau de la feuille TRIER STOCK le "haut" du tableau t
   Application.Goto Sheets("TRIER STOCK").Range("a1"), True
   With Sheets("TRIER STOCK").Range("a1").ListObject
      If .ListRows.Count > 0 Then .DataBodyRange.Delete
      For i = 1 To n: .ListRows.Add: Next
      .DataBodyRange = t
   End With
End Sub
Cliquez pour agrandir...
Bonjour mapomme,

Merci pour ton aide à ma demande.

Ta proposition fonctionne très bien et je vais la laisser en place 👍 .

La proposition de Dranreb était bien également, mais je n'arrivais pas à l'inclure dans mon fichier réel. Mais Merci à toi aussi Dranreb👍 .

C'est sympa d'avoir ces bons conseils et cette aide sur ce forum. SUPER et MERCI beaucoup.

A une prochaine fois certainement.

Marvin57
 
Vote positif 0 Vote négatif
M

Marvin57

XLDnaute Occasionnel
Dranreb à dit:
Pourquoi ?

Avec un Sujet renvoyé par la fonction SujetCBx du module de service MSujetCBx, pas besoin de refiltrer la base derrière: l'élément Suj(0) contient la liste des clés classée et sans doublon à affecter à la ComboBox1.List et Suj(1) contient les listes de numéros de lignes pour toutes les valeurs possibles où ces clés ont été trouvées dans la base.
Cliquez pour agrandir...
Re Dranreb,

vos codes fonctionne très bien sur le fichier que j'avais envoyé. Pas de soucis.
Mais dans le fichier réel je n'arrive pas à le faire fonctionner ! je ne suis pas si avancé dans le vba alors je n'ose pas trop y toucher.
Mais je vais faire une copie de mon fichier réel et essayer ces modifications ce week-end pour voir comment les incorporer dans le fichier.

En tout un grand MERCI à vous également, SUPER boulot.👍

A une prochaine fois.
Marvin57
 
Vote positif 0 Vote négatif
M

Marvin57

XLDnaute Occasionnel
Dranreb à dit:
Quelle difficulté rencontriez vous ?
Joignez un classeur de test ayant une structure plus proche de votre fichier réel.
Cliquez pour agrandir...
Bonjour Dranreb,

pour revenir à notre discussion, je vous informe que j'ai réussi à faire fonctionner le fichier.

L'erreur venait de ma part. J'avais mal placé les codes. Mais maintenant après plusieurs essais, tout fonctionne.

Encore MERCI pour votre aide et à une prochaine certainement.

Cordialement
Marvin57
 
Vote positif 0 Vote négatif
M

Marvin57

XLDnaute Occasionnel
Dranreb à dit:
Bonjour.
Pourrais-je en savoir plus, s'il vous plait, sur votre erreur de positionnement du code, que je puisse davantage orienter mes conseil à l'avenir ? (confusion entre variable globale et locale peut être ?)
Cliquez pour agrandir...
Re,

je n'avais pas modifié les noms dans le code ci-dessous, comme par exemple le combobox1 ou le nom de la feuille.


Private Sub CommandButton1_Click()
Dim TLgn() As Long, TDon(), LD&, TRés(), LR&, C&
If Not ComboBox1.MatchFound Then Exit Sub
TLgn = Suj(1)(ComboBox1.ListIndex)
TDon = RngDon.Value
ReDim TRés(1 To UBound(TLgn), 1 To 2)
For LR = 1 To UBound(TLgn)
LD = TLgn(LR)
For C = 1 To 2: TRés(LR, C) = TDon(LD, C): Next C, LR
TableauRetaillé(Feuil2.ListObjects(1)) = TRés
Feuil2.Activate
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
D'accord. C'est plus incitatif à ne pas l'oublier de toujours donner des noms mnémoniques aux contrôles, et à tous objets en général. Je les fait précéder d'un trigramme pris de cette liste :
1685959581558.png
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Autres Filtrer une listbox a partir d'une combobox
Réponses
9
Affichages
344
lyam
L
M
  • Résolu(e)
Microsoft 365 Rafraîchir listbox
Réponses
9
Affichages
886
Marvin57
M
M
  • Résolu(e)
Microsoft 365 Prochain numéro
Réponses
2
Affichages
389
Marvin57
M
E
  • Résolu(e)
Microsoft 365 ComboBox "dynamiques" sans doublon sur plusieurs colonnes
Réponses
2
Affichages
145
ExcLnoob
E
M
  • Résolu(e)
Microsoft 365 Copier par mois
2
Réponses
23
Affichages
789
Marvin57
M
M
  • Résolu(e)
Microsoft 365 Tableau et doublons
2
Réponses
15
Affichages
835
Marvin57
M
M
  • Question
XL 2010 Supprimer les doublons contenant une valeur zéro avec trois conditions
Réponses
2
Affichages
439
Mody200
M
M
  • Résolu(e)
Microsoft 365 code pour ajout
Réponses
13
Affichages
378
Marvin57
M
M
  • Résolu(e)
Autres extraire valeurs ligne par ligne sans doublons
Réponses
7
Affichages
250
mysti54
M
T
  • Résolu(e)
Microsoft 365 Créer un onglet pour chaque thème contenant les titres en doublons associés à ce thème
2
Réponses
25
Affichages
667
Toucan72
T

Membres actuellement en ligne

26 membres et 326 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 764
Messages
2 112 686
Membres
111 636
dernier inscrit
Lazher29