Discussion :

[jarault]

Bonjour,

J'ai un problème de tri de données que je n'arrive pas à résoudre.
J'ai partiellement résolu le problème, mais je pense que ma méthodologie n'est pas la bonne, en voici les données.

J'ai une feuille excel ou les utilisateurs doivent choisir les produits qui seront gérées par le stock.

Le stock gère 120 produits et ceux-ci sont caractérisés par 2 variantes: le nom du produit et son sous produit.

Il y'a 12 lignes de 10 produits les uns sous les autres.

L'utilisateur choisi le produit dans une liste déroulante (issue d'un tableau sur la même feuille), puis dans la case en-dessous choisit le sous-produit également dans une liste déroulante (issue d'un tableau sur la même feuille).

Mon premier problème était le suivant: le produit et le sous-produit pouvaient ne pas correspondre: pour résoudre ce problème j'ai procédé comme suit:

J'ai mis en place un code qui copie le produit choisit dans la case M50:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
Application.ScreenUpdating = False
 
    'Délimite les cellules de choix du produit
    Set Plage = Range("B4:K4,B8:K8,B12:K12,B16:K16,B20:K20,B24:K24,B28:K28,B32:K32,B36:K36,B40:K40,B44:K44,B48:K48")
 
    'Sort de la routine si ce n'est pas une cellule de produit
    If Application.Intersect(Target, Plage) Is Nothing Then
        Exit Sub
 
    'Lance la macro pour copier le produit choisi
    Else
        Application.Run "Copier_Accueil"
    End If
 
'Re-sélectionne la cellule d'origine
Target.Select
Application.ScreenUpdating = True
 
End Sub

et la macro "Copier_Accueil"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Copier_Accueil()
 
'Copie la valeur du produit pour trouver les sous-produits correspondants
    ActiveCell.Select
    Selection.Copy
    Range("M50").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Ma liste de produit possède à sa droite des numéros uniques qui caractérisent chaque produit, une formule dans la case N50 en extrait ce numéro à partir du nom du produit de la case M50:
Formule case N50 =SI(M50="";"";RECHERCHEV(M50;H52:I142;2))

Le numéro obtenu dans la case N50 me permet d'obtenir une liste qui n'affiche que les sous-produits qui correspondent (la liste des sous-produits possède à sa droite le numéro unique qui le relie à son produit).

La formule utilisée est la suivante: =SI($M$50="";"";(SI(K52=$N$50;DECALER(K52;0;-1);"")))

J'utilise alors cette nouvelle liste déroulante comme source pour le choix par l'utilisateur du sous-produit.

Mon problème est le suivant: il éxiste plus de 300 sous produits différents, à chaque choix de l'utilisateur celui-ci doit faire dérouler l'intégralité de la liste pour parcourir les différents choix, ce n'est vraiment pas pratique lorsqu'un produit ne posséde que 2 ou 3 sous-produits.

D'après-vous est-il possible que ma nouvelle liste soit triée pour écarter les cellules blanches ? Faut-il créer une nouvelle liste qui triera la liste précédente en ommettant les cellules vides ? et si oui comment ?

Merci par avance de votre aide

Jarault

[ancel17]

petite question :

un sous produit peut-il correspondre à plusieurs produits différents ?

[jarault]

petite question :

un sous produit peut-il correspondre à plusieurs produits différents ?

Oui tout à fait, le produit 1 peut avoir plusieurs sous-produits. Si le produit 1 à le numéro unique 18 alors tous les sous-produits qui lui correspondent ont également le même numéro de référence.

Jarault

[jarault]

Je viens de trouver une solution temporaire, par contre c'est très long (environ 7-8 secondes avant de pouvoir sélectionner la liste triée dans la liste déroulante):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
Application.ScreenUpdating = False
 
    Set Plage = Range("B4:K4,B8:K8,B12:K12,B16:K16,B20:K20,B24:K24,B28:K28,B32:K32,B36:K36,B40:K40,B44:K44,B48:K48")
 
    'Sort de la routine si ce n'est pas une cellule de produit
    If Application.Intersect(Target, Plage) Is Nothing Then
        Exit Sub
 
    'Lance la macro pour copier le produit choisi
    Else
        Application.Run "Copier_Accueil"
    End If
 
'Tri les sous-produits
Application.Run "trier_les_donnees"
 
'Re-sélectionne la cellule d'origine
Target.Select
Application.ScreenUpdating = True
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub trier_les_donnees()
Dim Cell As Range
Application.EnableEvents = False
Range("N52:N82").ClearContents
    For Each Cell In Range("M52:M302")
        Cell.Select
        If Cell <> "" Then Application.Run "recopier"
    Next Cell
Application.EnableEvents = True
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub recopier()
 
ActiveCell.Copy
Range("N50").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Si quelqun à quelquechose de plus simple et éfficace, je suis preneur,

Jarault

[ancel17]

Essaie ça dans le code de la feuille où l'utilisateur sélectionne ses produits et sous produits.

Si ça fonctionne tu peux supprimer tes modules ce que tu avais fais avant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column >= 2 And Target.Column <= 11 Then
    If (Target.Row - 1) / 4 = Int((Target.Row - 1) / 4) And Target.Row - 1 <= 48 Then
        Dim c As Range
        Dim fl1 As Worksheet
        Dim formule As String
        Set fl1 = ThisWorkbook.Worksheets(1)
        ' si ta colonne AA est utilisée, change pour une colonne dispo. Pense à le modifier partout dans le code
        fl1.Range("AA:AA").Clear
        ' remplace M1:M20 par ta plage correspondant à ta liste de produit
        For Each c In fl1.Range("M1:M20")
            If c.Value = Target.Offset(-1, 0).Value Then
               ' si R1 est pris, change pour une cellule dispo. Pense à le modifier partout dans le code
               fl1.Range("R1").Value = c.Offset(0, 1).Value
            End If
        Next c
        n = 0
        ' remplace O1:O50 par ta plage correspondant à ta liste de sous produits
        For Each c In fl1.Range("O1:O50")
            If c.Offset(0, 1).Value = fl1.Range("R1").Value Then
                n = n + 1
                fl1.Range("AA" & n).Value = c.Value
            End If
        Next c
        formule = "=$AA$1:$AA$" & n
        Target.Clear
        Target.Validation.Add xlValidateList, , , formule
    End If
End If
End Sub

j'ai testé chez moi, ça fonctionne.

[jarault]

Merci ,
J'essaye dès que possible et je te tiens au courant.

Jarault

Trop costaud ton code j'ai rien compris, faut que je travaille dessus