Tri combobox avec doublons

Le 28/08/2017 à 11:57

Bonjour à toutes et à tous,

J'utilise une BDD dans la feuille INVENTAIRE qui s'affiche dans une combobox triée a colonne unique (CB_PROD). Pour plus de facilité lors d'une recherche,

il suffit d'introduire "*" pour afficher tous les produits ou "*bleu" pour afficher tous les produits contenant le mot "bleu" par exemple.

Il est possible d'avoir 2 produits de noms identiques mais d'unités différentes :

Produit unité

------- -----

Tape blanc RLX

Tape blanc BTE

Ceci ne sera pas récurrent sur tous les produits mais exceptionnel.

Lorsque j'effectue une recherche sur "Tape blanc", je n'obtiens qu'une seule ligne car la macro effectue un tri sans doublon sur le nom uniquement.

Dès lors, comment pourrait-on afficher les 2 produits de noms identiques dans la combobox triée ? Pour moi, pas de souci si le nom apparaît 2 fois l'un à la suite de l'autre. Faudrait-il introduire 2 colonnes dans la combobox ?

Merci d'avance pour votre aide

'Tier la liste apparaissant dans CB_PROD et sans doublons
Dim d1
Dim tmp As String
Dim c As Range
Dim tbl As Variant 'déclare la variable tbl (TaBLeau)
Dim z As Integer 'déclare la variable z (incrément)
Dim j As Integer 'déclare la variable j (incrément)
Dim temp As Variant 'déclare la variable temp (valeur TEMPoraire)

If Me.CB_PROD <> "" Then

    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = "*" & UCase(Me.CB_PROD) & "*"
    For Each c In Sheets("INVENTAIRE").[LISTE]
    If UCase(c) Like tmp Then d1(c.Value) = ""
    Next c
    tbl = d1.keys 'définit le tableau des valeurs sans doublons
    'tri alphabétique
    For z = 0 To UBound(tbl) 'boucle 1 de 0 au nombre de valeur du tableau
    For j = 0 To UBound(tbl) 'boucle 2 de 0 au nombre de valeur du tableau
    If tbl(z) < tbl(j) Then 'condition : si la valeur de la boucle 1 est invérieure à la valeur de la boucle 2
        temp = tbl(z) 'définit la valeur temporaire temp
        tbl(z) = tbl(j) 'la valeur de la boucle un devient la valeur de la boucle 2
        tbl(j) = temp 'la valeur de la boucle deux devient la valeur temporaire temp
    End If 'fin de la condition
        Next j 'prochaine valeur de la boucle 2
        Next z 'prochaine valeur de la boucle 1

        Me.CB_PROD.List = tbl
        Me.CB_PROD.DropDown

End If

Le 28/08/2017 à 14:52

Bonjour,

je mettrai l'unité dans la clé de la collection de type Dictionnaire et je prendrai uniquement les produits pour la liste de la combobox.

En supposant que l'unité se trouve dans la colonne juste à droite du produit, ci-dessous exemple de code :

    clé = c.Value & "." & c.Offset(, 1).Value
    If UCase(c) Like tmp Then d1(clé) = c.Value
    Next c
    tbl = d1.Items 'définit le tableau des valeurs sans doublons sur produit + unité

Le 28/08/2017 à 15:28

thev a écrit :
Bonjour,
je mettrai l'unité dans la clé de la collection de type Dictionnaire et je prendrai uniquement les produits pour la liste de la combobox.
En supposant que l'unité se trouve dans la colonne juste à droite du produit, ci-dessous exemple de code :
    clé = c.Value & "." & c.Offset(, 1).Value
    If UCase(c) Like tmp Then d1(clé) = c.Value
    Next c
    tbl = d1.Items 'définit le tableau des valeurs sans doublons sur produit + unité

Bonjour thev.

Merci pour le retour rapide

Les 2 produits de noms identiques (sauf leur unité) apparaissent bien dans le combobox mais il y a un apparemment un problème de mise à jour de la quantité dans le formulaire.

En tapant le produit almanach (lignes 360 et 361 -> INVENTAIRE), les quantités ne se mettent pas à jour (voir fichier joint).

De même, serait-il possible d'utiliser plutôt un textbox pour effectuer la recherche de produit qui s'afficherait au fur et à mesure dans le combobox (saisie intuitive). De cette manière, je pourrais empêcher l'écriture dans le combo. Si oui, comment faire ?

Merci d'avance pour ton aide

43inventaire.xlsm (185.36 Ko)

Le 28/08/2017 à 20:26

Bonsoir,

Une solution avec ces modifications de code :

1- définition d'une variable objet produits au niveau du module du UserForm

Dim produits As Object

Sub LISTE()
Dim derniereLigne As Long

derniereLigne = ActiveWorkbook.Worksheets("INVENTAIRE").Range("B" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets("INVENTAIRE").Range("B2:B" & derniereLigne).Name = "LISTE"

End Sub

2- modification de la procédure évenementielle" CB_PROD_Change()"

Private Sub CB_PROD_Change()

'Tier la liste apparaissant dans CB_PROD et sans doublons
Dim produits_triés As Object
Dim tmp As String, clé As String

'Hook_Mouse
intTopIndex = Me.CB_PROD.TopIndex

If produits Is Nothing Then
    Set produits = CreateObject("System.Collections.Sortedlist")
    tmp = UCase(Me.CB_PROD) & "*"
    For Each c In Range("LISTE")
        clé = c.Value & "." & c.Offset(, 1).Value
        If UCase(c) Like tmp Then produits(clé) = c.Value
    Next c
    Set produits_triés = CreateObject("System.Collections.Arraylist")
    produits_triés.addrange (produits.Values)   'définit le tableau des valeurs sans doublons sur produit + unité

    Me.CB_PROD.List = produits_triés.toarray
    Me.CB_PROD.DropDown
End If

End Sub

3- modification de la procédure évenementielle" CB_PROD_Click()

Private Sub CB_PROD_Click()
Dim valeur1, valeur2 As String, clé As String, produit As String, unité As String
Dim cell As Range, cell0 As Range
Dim i As Integer, statut As Integer

Me.TB_REM.Value = ""

Me.CB_PROD.BackColor = vbWhite

'// récupération clé produit correspondant au produit sélectionné
clé = produits.getkey(Me.CB_PROD.ListIndex)
produit = Split(clé, ".")(0)
unité = Split(clé, ".")(1)

'// recherche ligne de la plage "LISTE" de la feuille inventaire correspondant à la clé sélectionnée
i = 0
Set cell = Range("LISTE").Find(produit)
If Not cell Is Nothing Then
    Set cell0 = cell
    Do
        If cell.Offset(, 1) = unité Then i = cell.Row - Range("LISTE").Row + 1: Exit Do
        Set cell = Range("LISTE").FindNext(cell)
    Loop Until cell.Address = cell0.Address
End If

statut = Range("LISTE").Offset(, 4).Rows(i)

If statut <> 0 Then

    Me.TB_QTEDISPO.Caption = Range("LISTE").Offset(, 3).Rows(i)
    Me.TB_UNITE.Value = Range("LISTE").Offset(, 1).Rows(i)
    Me.TB1.SetFocus

    If MsgBox("  Produit déjà inventorié !" & Chr(13) & Chr(13) & "  Souhaitez-vous à nouveau l'inventorier ?", vbYesNo + vbExclamation, "") = vbYes Then

        Me.TBCAT.ForeColor = vbRed
        Me.TBCAT.Caption = "Statut " & statut
        Me.TB_QTEINV.Value = ""
        Me.TB_QTEINV.SetFocus

    Else

        Me.TBCAT.Caption = ""
        Me.TB_QTEINV.Value = ""
        Me.TB_QTEDISPO.Caption = ""
        Me.TB_UNITE.Value = ""
        Me.CB_PROD.ListIndex = -1
        Me.CB_PROD.SetFocus

    End If

Else

    Me.TBCAT.ForeColor = RGB(0, 128, 0)
    Me.TBCAT.Caption = "Statut 0"

    Me.TB_QTEDISPO.Caption = Range("LISTE").Offset(, 2).Rows(i)
    Me.TB_UNITE.Value = Range("LISTE").Offset(, 1).Rows(i)

End If

Me.TB_REM.Value = ""

End Sub

4- ajout d'une procédure événementielle pour réinitialiser la Combobox Produits via utilisation de la touche Supp (Del)

Private Sub CB_PROD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyDelete Then Me.CB_PROD.Clear: Set produits = Nothing
End Sub

Le 29/08/2017 à 09:23

Bonjour,

Merci pour cette proposition

Le code semble fonctionner mais la saisie intuitive n'est apparemment plus fonctionnelle.

Est-ce possible de combiner les 2 ou faut-il faire l'impasse ?

Merci d'avance

Le 29/08/2017 à 11:38

Bonjour,

Actuellement la saisie intuitive est fondée sur la première lettre entrée dans la combobox vide ou réinitialisée. La liste offerte dans la Combobox ne commence que par cette lettre.

Est-ce suffisant ? faudrait-il prévoir plus de lettres ?

L'alternative est cette modification via appui sur la touche Entrée

Private Sub CB_PROD_Change()

    'Hook_Mouse
    intTopIndex = Me.CB_PROD.TopIndex

End Sub

Private Sub CB_PROD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyDelete Then Me.CB_PROD.Clear: Set produits = Nothing

    If KeyCode = vbKeyReturn Then
        'Tier la liste apparaissant dans CB_PROD et sans doublons
        Dim produits_triés As Object
        Dim tmp As String, clé As String

        If produits Is Nothing Then
            Set produits = CreateObject("System.Collections.Sortedlist")
            tmp = UCase(Me.CB_PROD) & "*"
            For Each c In Range("LISTE")
                clé = c.Value & "." & c.Offset(, 1).Value
                If UCase(c) Like tmp Then produits(clé) = c.Value
            Next c
            Set produits_triés = CreateObject("System.Collections.Arraylist")
            produits_triés.addrange (produits.Values)   'définit le tableau des valeurs sans doublons sur produit + unité

            Me.CB_PROD.List = produits_triés.toarray
            Me.CB_PROD.DropDown
        End If

    End If
End Sub

Le 29/08/2017 à 11:52

thev a écrit :
Bonjour,
Actuellement la saisie intuitive est fondée sur la première lettre entrée dans la combobox vide ou réinitialisée. La liste offerte dans la Combobox ne commence que par cette lettre.
Est-ce suffisant ? faudrait-il prévoir plus de lettres ?

Bonjour,

L'idéal serait la saisie semi-automatique.

La liste des noms apparaît au fur et à mesure de la frappe des premières lettres (comme sur Google)

*bleu -> touts les produits contenant le mot bleu

* = tous les produits

f -> tous les produits commençant par la lettre f ou F

fe -> tous les produits commençant par la lettre fe ou Fe

...et ainsi de suite...

Merci

Le 29/08/2017 à 12:39

Après réflexion, il suffit de changer l'instruction

If produits is Nothing

par

If CB_PROD.ListIndex = -1

Private Sub CB_PROD_Change()

    'Hook_Mouse
    intTopIndex = Me.CB_PROD.TopIndex

    'Tier la liste apparaissant dans CB_PROD et sans doublons
    Dim produits_triés As Object
    Dim tmp As String, clé As String

    If CB_PROD.ListIndex = -1 Then
        Set produits = CreateObject("System.Collections.Sortedlist")
        tmp = UCase(Me.CB_PROD) & "*"
        For Each c In Range("LISTE")
            clé = c.Value & "." & c.Offset(, 1).Value
            If UCase(c) Like tmp Then produits(clé) = c.Value
        Next c
        Set produits_triés = CreateObject("System.Collections.Arraylist")
        produits_triés.addrange (produits.Values)   'définit le tableau des valeurs sans doublons sur produit + unité

        Me.CB_PROD.List = produits_triés.toarray
        Me.CB_PROD.DropDown
    End If

End Sub

Le 29/08/2017 à 13:41

Le code semble fonctionner

Un tout grand merci à toi thev !

Bonne journée

Le 29/08/2017 à 15:48

Rebonjour,

Sans vouloir abuser, j'ai encore une petite question.

1) Dans le même ordre d'idée, serait-il possible d'effectuer la recherche de produits depuis un textbox au lieu d'un combobox ?

(voir fichier joint)

2) Existe-t-il un code pour l'ajustement automatique des colonnes d'un textbox ?

Merci d'avance