Code qui plante en bas de page
Bonjour à tous,
Je vous présente mon problème :
Je rentre un nom dans une textbox, le code va chercher un nom équivalent dans la colonne "I" et me renvoi, dans une listbox, le texte de la colonne "A" de la même ligne, en supprimant les doublons.
Cela fonctionne très bien sauf quand il ne trouve pas le nom recherché dans la première page de ma feuille "macave", le code plante. En revanche, quand il trouve dans la première page, il continue dans les pages suivantes de ma feuille.
Si quelqu'un a une idée merci d'avance.
Private Sub CommandButtonRechercheVin_Click()
Dim Cel As Range, Depart As String, Ref As String
Dim Mondico As Object
'efface le contenu de la listbox1'
Me.ListBox1.Clear
'recherche dans la colonne I'
Ref = Me.TextBox1.Text
' Object qui n'accepte pas les doublons
Set Mondico = CreateObject("Scripting.dictionary")
With Sheets("Ma Cave")
Set Cel = .Columns("I").Cells.Find(What:=Ref, LookIn:=xlValues, lookat:=xlPart)
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
Mondico(.Range("A" & Cel.Row).Value) = ""
Set Cel = .Columns("I").Cells.FindNext(Cel)
Loop While Depart <> Cel.Address
Me.ListBox1.List = Application.Transpose(Mondico.keys)
Else
'si pas trouvé le met dans la liste'
MsgBox "Pas trouvé de vin en accord avec " & Ref & "", vbCritical
End If
End With
End Sub
Bonjour,
J'ai testé ton code sur un2 liste de 3 pages et je n'ai rencontré aucun problème.
Avec un exemple, peut-être ?
A+
Bonjour
Bonjour frangy
Pour trouver (peut-être) le défaut, ton fichier est souhaitable
Tu indiques la démarche à suivre pour provoquer l'erreur
Merci pour vos réponses, en voulant joindre un fichier simplifié je viens de comprendre que ça ne bug pas en bas de page mais lorsque le code ne trouve qu'un unique résultat dans la colonne "I" (c'était une coincidence).
Le code bug sur la ligne :
"Loop While Depart <> Cel.Address"
Je crois comprendre pourquoi ça bug mais je ne sais pas encore comment le corriger.
Bonjour,
Doit-on comprendre que tu ne joins pas le fichier parce que tu souhaites trouver la solution par toi-même ?
A+
J'essaie mais je galère, je suis pas très bon
Bon, me revoilà avec un code complètement différent et qui marche bien sauf pour la dernière ligne qui n'ai jamais prise en compte, je ne comprends pas.
Private Sub CommandButtonRechercheVin_Click()
Dim Lig As Long, drLig As Long, Temp As Long, ref As String
Sheets("Ma Cave").Activate
ref = Me.TextBox1.Text
With Me.ListBox1
.Clear: If ref = "" Then Exit Sub
End With
With Sheets("Ma Cave")
drLig = Range("I" & Rows.Count).End(xlUp).Row
On Error GoTo TraitementErreur
Lig = Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart).Row
On Error GoTo 0
If Lig <> 0 Then
ajout_liste ListBox1, .Range("A" & Lig).Value
Do
On Error GoTo TraitementFin
Temp = Range("I" & Lig & ":I" & drLig).Cells.Find(ref).Row
If Temp = Lig Then Exit Do Else ajout_liste ListBox1, .Range("A" & Temp).Value: Lig = Temp
Loop
End If
End With
TraitementFin:
ListBox1.Visible = True
Exit Sub
TraitementErreur:
MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical
End Sub
Private Sub ajout_liste(LB As Object, c As String)
LB.ListIndex = -1
On Error Resume Next
LB.Text = c
On Error GoTo 0
If LB.ListIndex = -1 Then LB.AddItem c
End Sub
Pardon d'avoir tarder à répondre mais il est difficile de joindre le fichier, même raccourci au minimum et compressé il dépasse les 2 Mo.
Pour les interessés, voici le code qui marche:
Private Sub CommandButtonRechercheVin_Click()
Dim Cel As Range, Depart As String, ref As String
Sheets("Ma Cave").Activate
ref = Me.TextBox1.Text
With Me.ListBox1
.Clear: If ref = "" Then Exit Sub
.Visible = False
End With
With Sheets("Ma Cave")
Set Cel = .Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart)
If Not Cel Is Nothing Then
ajout_liste ListBox1, .Range("A" & Cel.Row).Value
Depart = Cel.Address
Do
Set Cel = .Columns("I").Cells.FindNext(Cel)
If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value Else Exit Do
Loop While Depart <> Cel.Address
Else
MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical
End If
End With
ListBox1.Visible = True
End Sub
Private Sub ajout_liste(LB As Object, c As String)
LB.ListIndex = -1
On Error Resume Next
LB.Text = c
On Error GoTo 0
If LB.ListIndex = -1 Then LB.AddItem c
End Sub