Rectifier un probleme code VBA (distinguer les doublons)
salut
dans la feuille stock lorsque je clique sur cherche puis recherche par Ref apres je clique sur la première référence il me donne des informations (la désignation .référence quantité prix.....)
lorsque je passe aux autres références les infos ne changent pas!!!!!il fallait se change selon le tebleau.
si vous pouvez m'aider svp.merci beaucoup
cordialement
medjsk, le forum,
Une suggestion à tester. Remplacer la macro "ListBox1_Click" par :
Private Sub ListBox1_Click()
On Error Resume Next
ListBox2.ListIndex = ListBox1.ListIndex
i = ListBox1.ListIndex + 2
For k = 2 To 16
Controls("TextBox" & k) = fh.Cells(i, k - 1)
Next
Range(Cells(i, 1), Cells(i, 15)).Select
End SubLaCéline
SALUT LACELINE
j'ai mis ton code mais il ya un probleme voir fichier ci-joint (feuille stock)
lorsque je clique recherche par référence par exemple j’écris HF dans la case saisir des lettres ou des chiffre qui se suivent
jai constaté qu'il m'affiche pas leurs informations selon le tableau!!!!!
merci infiniment
bye
medjsk, le forum,
Désolée, je n'ai regardé que pour la sélection d'un élément dans la ListBox1, sans la discrimination via le TextBox1.
Car, effectivement, ce code ne convient plus ainsi.
LaCéline
medjsk, le forum,
La recherche se fait sur des colonnes où les informations y sont identiques, selon l'exemple fourni.
Est-ce que cet exemple est bien représentatif de la réalité?
Sans clé unique, il est bien difficile de discriminer.
Je recherche une autre méthode.
LaCéline
Bonjour
si la référence sont identique (colonne J )on peut discriminer par rapport au N° de bon de sortie (colonne A) .merci
mes salutations
Bonjour,
Pour le test, mets tout ton code de l'UserForm5 en commentaire et colles celui-ci dans son module pour les tests :
Dim fm As Worksheet, fh As Worksheet
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_Click()
Dim K As Long
'il est préférable de gérer l'erreur plutôt que l'ignorer !
If ListBox2.ListCount > 0 Then
ListBox2.ListIndex = ListBox1.ListIndex
End If
With ListBox1
For K = 2 To 16
Controls("TextBox" & K) = fh.Cells(.List(.ListIndex, 1), K - 1)
Next
End With
End Sub
Private Sub OptionButton1_Click()
Remplir 9
End Sub
Private Sub OptionButton2_Click()
Remplir 9, 10
End Sub
Private Sub OptionButton3_Click()
Remplir 6, 9
End Sub
Sub Remplir(Col1 As Integer, Optional Col2)
Dim I As Long
Dim DerLn As Long
ListBox1.Clear
ListBox2.Clear
For I = 1 To 16
Controls("TextBox" & I) = ""
Next I
DerLn = fh.Cells(Rows.Count, 1).End(xlUp).Row 'sur colonne A
For I = 2 To DerLn
ListBox1.AddItem fh.Cells(I, Col1).Value
ListBox1.Column(1, I - 2) = I
If Not IsMissing(Col2) Then 'si le second argument est passé
ListBox2.AddItem fh.Cells(I, Col2).Value
ListBox2.Column(1, I - 2) = I
End If
Next I
End Sub
Private Sub TextBox1_Change()
Dim liste()
Dim K As Long
Dim I As Long
For I = 0 To ListBox1.ListCount - 1
If ListBox1.List(I) Like "*" & UCase(TextBox1.Text) & "*" Then
K = K + 1
ReDim Preserve liste(1 To 3, 1 To K)
liste(1, K) = ListBox1.List(I)
If ListBox2.ListCount > 0 Then liste(2, K) = ListBox2.List(I)
liste(3, K) = ListBox1.List(I, 1)
End If
Next I
For I = 2 To 16
Controls("TextBox" & I) = ""
Next I
If Not (Not liste) Then
ListBox1.Clear
ListBox2.Clear
For I = 1 To UBound(liste, 2)
ListBox1.AddItem liste(1, I)
ListBox2.AddItem liste(2, I)
ListBox1.Column(1, I - 1) = liste(3, I)
Next I
End If
End Sub
Private Sub UserForm_Initialize()
UserForm1.Width = 275
Set fm = Sheets("MAGASIN")
Set fh = Sheets("Stock")
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "117,05;0"
End SubSALUT theze
J'ai fait coller ton code dans l user forme 5
j'ai constater un problème pendant le test (voir photo joint)
lorsque je recherche par référence il m'affiche pas les référence sur cote gauche!!!! car quand j’écris la reference que je cherche dans la case saisir des lettre et des chiffres qui se suivent il selectionne pas ce que je cherche.
il fallait les affiche sur cote droit comme avant pour choisir la référence que je veux.
merci beuacoup
Bonjour,
Je ne sais pas si j'ai bien compris, tu veux pouvoir faire une recherche par référence si le bouton d'option "ref" est choisi et que la ListBox2 est remplie ?
Dans ce cas, remplace le code "TextBox1_Change()" que je t'ai donné dernièrement par celui-ci :
Private Sub TextBox1_Change()
Dim Lst As MSForms.ListBox
Dim liste()
Dim K As Long
Dim I As Long
If OptionButton2.Value = True Then Set Lst = ListBox2 Else Set Lst = ListBox1
For I = 0 To ListBox1.ListCount - 1 'étant d'office toujours remplie !
If Lst.List(I) Like "*" & UCase(TextBox1.Text) & "*" Then
K = K + 1
ReDim Preserve liste(1 To 3, 1 To K)
liste(1, K) = ListBox1.List(I)
If ListBox2.ListCount > 0 Then liste(2, K) = ListBox2.List(I)
liste(3, K) = ListBox1.List(I, 1)
End If
Next I
For I = 2 To 16
Controls("TextBox" & I) = ""
Next I
If Not (Not liste) Then
ListBox1.Clear
ListBox2.Clear
For I = 1 To UBound(liste, 2)
ListBox1.AddItem liste(1, I)
ListBox2.AddItem liste(2, I)
ListBox1.Column(1, I - 1) = liste(3, I)
Next I
End If
End SubSALUT
lorsque je clique sur recherche par référence et j’écris la référence que je cherche il m'affiche pas celle que je cherche tout seule!!!
merci beaucoup
Bonjour,
Effectivement, j'ai fais l'erreur de partir de ton code de recherche mais voilà celui qu'il te faut :
Private Sub TextBox1_Change()
Dim Col As Integer
Dim DerLn As Long
Dim I As Long
Dim J As Long
DerLn = fh.Cells(Rows.Count, 1).End(xlUp).Row 'sur colonne A
If OptionButton2.Value = True Then Col = 10 Else Col = 9
ListBox1.Clear
ListBox2.Clear
For I = 2 To DerLn
If fh.Cells(I, Col).Value Like "*" & UCase(TextBox1.Text) & "*" Then
ListBox1.AddItem fh.Cells(I, 9).Value
ListBox1.Column(1, J) = I
ListBox2.AddItem fh.Cells(I, 10).Value
ListBox2.Column(1, J) = I
J = J + 1
End If
Next I
End SubSALUT
lorsque j'ecris dans la case recherche par lettre ou chiffre qui se suivent il m'affiche cet erreur.
merci THEZE.
Re,
Chez moi ça fonctionne très bien !
Voilà ce que je fais et de la façon dont j'ai compris ta demande :
Je clique sur le bouton d'option "Ref", les deux ListBox se remplissent, j'entre dans le TextBox1 par exemple la lettre c et j'ai bien dans la ListBox1 les quatre "TORQUE GAUGE" et dans la ListBox2 les références correspondantes !
J'ai créé des valeurs bidons pour augmenter le nombre de lignes et ça fonctionne parfaitement du moment que j'entre une lettre (ou plusieurs) ou un chiffre (ou plusieurs) et si je vide le TextBox1, toute la liste est chargée !
Si tu as modifié ton classeur par rapport au premier posté, reposte la dernière version que je puisse faire des tests !
Salut Theze
si vous pouvez m'envoyer le fichier à tester svp
thank you so much
SALUT
il fonctionne bien. merci
dans la feuille bon de sortie
si je remplis la désignation et puis la quantité il me demande si vous allez retirer la quantité du magasin si clique sur oui il la retirer du feuille magasin ok
le problème si je clique sur non il supprime la quantité que j’écris dans le bon de sortie!!!
alors mois il ya des cas ou je remplis la quantité sans la retirer du magasin il doit pas m’empêche de l’écrire
merci beaucoup Theze
Bonsoir,
Essai avec ce code (remplace l'actuel) :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 2 Then Exit Sub
Application.EnableEvents = False
Set fb = Sheets("BON DE SORTIE")
Set fm = Sheets("MAGASIN")
DerLn = Application.Max(11, fb.Range("B" & Rows.Count).End(xlUp).Row)
If Not Intersect(Target, fb.Range("O11:O" & fb.Range("O" & DerLn).Row)) Is Nothing Then
If MsgBox("Vous allez retirer une quantité de " & Target & " à la quantité de '' " & Target.Offset(0, -12) & _
" disponible en magasin." & Chr(13) & Chr(13) & _
"Confirmez-vous ?", vbExclamation + vbYesNo) = vbNo Then Exit Sub
fm.Range("O" & refln) = fm.Range("O" & refln) - Target
End If
Application.EnableEvents = True
End SubSalut Theze
une fois je clique sur non il ne la retire pas la quantité du magasin et il me permet de remplir Q11 c'est parfait. ok
mais le problème si je vais remplir la deuxième ligne de bon de sortie Q13 il me demande plus is je vais la retirer du magasin!!!
si cela est possible de régler le problème . merci
mes salutations
Bonjour,
Effectivement, je n'ai pas percuté qu'il u a une suspension des évènements (Application.EnableEvents = False) qui ne sert strictement à rien dans le code car on ne doit l'utiliser que quand on fait une modif sur la feuille même et pas dans une autre (ce qui va engendrer à nouveau l'évènement "Worksheet_Change") !
Voici le code corrigé. Attention tout de même, il y a une variable qui risque de créer un bug car elle traîne un peu partout dans le projet et on ne sait pas trop où elle est initialisée, c'est la variable "refln". Je ne me suis pas amusé à la suivre :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLn As Long
If Target.Count > 2 Then Exit Sub
Set fb = Sheets("BON DE SORTIE")
Set fm = Sheets("MAGASIN")
DerLn = Application.Max(11, fb.Range("B" & Rows.Count).End(xlUp).Row)
If Not Intersect(Target, fb.Range("O11:O" & fb.Range("O" & DerLn).Row)) Is Nothing Then
If MsgBox("Vous allez retirer une quantité de " & Target & " à la quantité de '' " & Target.Offset(0, -12) & _
" disponible en magasin." & Chr(13) & Chr(13) & _
"Confirmez-vous ?", vbExclamation + vbYesNo) = vbNo Then Exit Sub
fm.Range("O" & refln) = fm.Range("O" & refln) - Target
End If
End SubSALUT Theze
il fonctionne bien
je veux ajouter une chose a ce code pour qu'il deviendra parfait
si je ne ferai pas sortir un élément de la feuille magasin ca veut dire( j’écris directement l’élément dans le bon de sortie)
et supposant que je me suis trompe j'ai clique oui retirer la quantité du magasin. il doit pas la retirer il doit m’empêcher.
car l’élément n'a pas sortie du magasin.
je vous remercie beaucoup