Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Doublons dans combobox

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
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 =...

Marvin57

XLDnaute Occasionnel
Bonjour.
Ma solution.
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
 

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:

Dranreb

XLDnaute Barbatruc
dans mon fichier réel il m'est impossible de placer tous tes codes en plus.
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.
 

Marvin57

XLDnaute Occasionnel
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
 

Marvin57

XLDnaute Occasionnel
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
 

Marvin57

XLDnaute Occasionnel
Quelle difficulté rencontriez vous ?
Joignez un classeur de test ayant une structure plus proche de votre fichier réel.
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
 

Dranreb

XLDnaute Barbatruc
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 ?)
 

Marvin57

XLDnaute Occasionnel
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 ?)
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
 

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 :
 

Discussions similaires

Réponses
9
Affichages
886
Réponses
2
Affichages
390
  • Résolu(e)
Microsoft 365 Copier par mois
Réponses
23
Affichages
791
Réponses
15
Affichages
835
Réponses
13
Affichages
378
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…