Macro qui rempli une liste box et qui réccupére les donnée [Résolu/Fermé]

Signaler
Messages postés
88
Date d'inscription
jeudi 19 mai 2016
Statut
Membre
Dernière intervention
17 août 2016
-
Messages postés
88
Date d'inscription
jeudi 19 mai 2016
Statut
Membre
Dernière intervention
17 août 2016
-
Bonjour les amis svp j'ai besoin de votre aide pour faire une macro qui rempli une liste box et qui réccupére les donnée sélectionner et les met dans la colonne A;B;C


en faite j'ai une interface dans laquelle j'ai

das bouton Ajout Plat1 ; Ajout Plat2 ;Ajout Plat3 ...........
et une listeBox1


sur la méme feuille j'ai

la colonne A;B et C ou je veux mettre ce que j'ai sélectionner dans cette interface


et les donnée sont placer dans la feuille "Donnees"



ce que je veux faire svp c'est quand j’appuie sur Ajout Plat2 par exemple

que dans ma listeBox1 je trouve tous les code familles qui passe sur Plat2 (regarde l'image ou il ya les donner tu va voir que chaque code famille correspond a un PlatX)


et que une fois que je les est sélectionner je met le code famille dans la colonne A ; le code équipement dans B et le Plat qu'on a ajouter dans C

https://www.cjoint.com/c/FGCoMKo4CPh

merci beaucoup

3 réponses

Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Re,

Le fichier : https://www.cjoint.com/c/FGCpGM6JEPf

Le code :

Sub Ajout_Plat1()

Dim DL As Long, i As Integer, j As Integer

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat1" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Ajout_Plat2()

Dim DL As Long, i As Integer, j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat2" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Ajout_Plat3()

Dim DL As Long, i As Integer, j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat3" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Ajout_Plat4()

Dim DL As Long, i As Integer, j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat4" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Ajout_Plat5()

Dim DL As Long, i As Integer, j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat5" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Ajout_Plat6()

Dim DL As Long, i As Integer, j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("H" & i) = "Plat6" Then

Sheets(2).ListBox1.AddItem Sheets(1).Range("A" & i).Value

End If

Next i

End Sub

Sub Vider_Selection()

Dim j As Integer

    For j = 1 To Sheets(2).ListBox1.ListCount

        Sheets(2).ListBox1.RemoveItem 0

    Next j
           
End Sub


Sub Remplir()

DL = Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row
DL2 = Sheets(2).Cells(Application.Rows.Count, 1).End(xlUp).Row

For i = 2 To DL

If Sheets(1).Range("A" & i).Value = Sheets(2).ListBox1.Value Then

    Sheets(2).Range("A" & DL2 + 1).Value = Sheets(1).Range("A" & i).Value
    Sheets(2).Range("B" & DL2 + 1).Value = Sheets(1).Range("C" & i).Value
    Sheets(2).Range("C" & DL2 + 1).Value = Sheets(1).Range("H" & i).Value
    
End If

Next i

End Sub


Après honnêtement, j'ai fait une macro pour te faire plaisir qui vide la listbox mais elle n'est pas utile, je la vide à chaque nouveau clic sur Plat1 ou Plat2 etc.

Espérant que cela te convienne.

Cordialement.
Messages postés
88
Date d'inscription
jeudi 19 mai 2016
Statut
Membre
Dernière intervention
17 août 2016

Kuartz t'est vraiment génial merci beaucoup

c'est exactement ce que je veux merciiiiiiii
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Mais de rien :)
Bonjour Kuartz cava j'ai encore besoin de ton aides stp sur un sujet sur lequel tu m'a aider la semaine dernière

je vais te mettre stp le fichier en piéce joint :

ma macro est placer dans le module3 c'est une macro qui recherche les données et les met dans un tableau dans la feuille "Qtité Famille "

cette macro me cherche les données liée a chaque familles dans les autre onglet et me met les donnée chercher dans la feuilles "Qtité Famille "

ce que je veux maintenant stp c'est m'aider a chercher d'autre information que je veux mettre dans les colonnes "AF/AG/AH /AI"
j'ai essayer de le faire dans la macro c'est la parti que j'ai écrit entre des *************

mais malheureusement ca marche pas

je sais pas qu'est ce que il faux que je modifie dans ma macro pur que ca marche

voila le fichier

http://www.cjoint.com/c/FHbiHToGnHh

regarde stp et si ta pas compris je peux t'expliquer plus en détail

merci
Kuartz malheureusement la macro prend a peu prés entre 1 et 2 min pour s’exécuter donc ne te dit pas que CA marche pas il faut juste attendre
Kuartz t'est la ? j'ai vraiment besoin de ton aide stp
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Bonjour,

Je regarde ça demain. Je n'ai vraiment pas le temps là tout de suite désolé....

Cordialement.
ok ya pas de soucie Kuartz prend ton temps

merci déja juste pour la réponse

bonne soirée
Bonjour Kuartz est ce que t'a un peu de temps pour m'aidez stp je suis bloquer sur un truc
merci
Messages postés
88
Date d'inscription
jeudi 19 mai 2016
Statut
Membre
Dernière intervention
17 août 2016

Bonjour Kuartz


STP je voudrais rajouter des amélioration a ma macro

la macro si dessous me permet de faire une copie de la zone sélectionner dans la colonne C de la feuille ordonnancement et me cherche d'autre famille aléatoir pour les affecter a la zone que j'ai coller , sauf que maintenant je veux rajouter une condition; c'est que les familles que je veux affecter a la zone que j'ai coller doivent tous avoir un code équipement < 2.

je vais vous mettre le fichier ci joint pour essayer ce qui fonctionne maintenant c'est dans la feuille Ordonnancement

ma macro actuelle me permet de faire ceci :

si je sélectionne une zone dans la colonne C de la feuille ordonnancement j'ai un message box qui sort pour me demander le nombre de fois que je veux coller cette zone dans la colonne C


ensuite elle me colle la zone dans la colonne C et lui affecte des famille aléatoire qui ont différent code équipement

et moi je veux que toute les famille qui seront affecter doivent voir un code équipement inférieur a 2

les données sont dans la colonne P et Q de la feuille "Donnees"

https://www.cjoint.com/c/FHjj3NjWtsh
MERCI BEAUCOUP

   Sub Dupliquer5Selection()
Dim splat As String
Dim PlS As Range, hpl%, i%, n%
Dim kR As Long, v As Single
Dim RngCum As Range
kR = Range("A" & Rows.Count).End(xlUp).Row '--- dernière ligne utilisée en colonne A
kR = kR + 1 '--- ligne sur laquelle il faut indiquer le produit tiré au sort

n = Int(Application.InputBox("Nombre de duplications ?", "Dupliquer plage sélectionner", Type:=1))
Set PlS = Selection
hpl = PlS.Rows.Count
For i = 1 To n
PlS.Offset(i * hpl).Value = PlS.Value
Next i
Set RngCum = Worksheets("Donnees").Range("O2:S1000") '--- plage utilisée pour le tirage

Do

v = Rnd()


Cells(kR, 1) = WorksheetFunction.VLookup(v, RngCum, 2) '--- code produit en colonne 1(A)
Cells(kR, 2) = WorksheetFunction.VLookup(v, RngCum, 3) '--- code produit en colonne 1(A)
kR = kR + 1


Loop Until Cells(kR, 3) = splat
Set RngCum = Nothing
End Sub

Messages postés
88
Date d'inscription
jeudi 19 mai 2016
Statut
Membre
Dernière intervention
17 août 2016

c'est bon merci résolu