Boucle sans fin

[Cougar]

Bon matin le forum,

Dans le code suivant j'ai une boucle sans fin. Quel est mon erreur ?

Private Cel As Range
Private L1 As Integer, L2 As Integer, L3 As Integer
Private P1 As Range, P2 As Range, P3 As Range
Private x As Integer
Public F As Variant
Public L As Integer
Public A As Integer

Private Sub CmdEffacer_Click()
Dim Tableau As Variant

ComboBox1.ListIndex = -1
ComboBox2.ListIndex = -1
ComboBox3.ListIndex = -1
ListBox1.Clear
ListBox2.Clear
ListBox3.Clear
ListBox4.Clear
ListBox5.Clear
TxtDate.Clear
TxtAchete.Clear
TxtPrix.Clear
End Sub

Private Sub ComboBox1_Change()
Dim tabtemp As Variant
Dim F As Variant

ComboBox2.Clear
ComboBox3.Clear
ComboBox2.Enabled = True
ComboBox3.Enabled = True
ListBox1 = ''
ListBox2 = ''
ListBox3 = ''
ListBox4 = ''
ListBox5 = ''
TxtDate = ''
TxtAchete = ''
TxtPrix = ''

For Each Cel In P1
If Cel.Value = ComboBox1.Value Then
If ComboBox2.ListCount > 0 Then
For x = 0 To ComboBox2.ListCount - 1
If Cel.Offset(0, 1).Value = ComboBox2.List(x) Then GoTo saut1
Next x
End If
ComboBox2.AddItem Cel.Offset(0, 1).Value

saut1:
If ComboBox3.ListCount > 0 Then
For x = 0 To ComboBox3.ListCount - 1
If CStr(Cel.Offset(0, 2).Value) = CStr(ComboBox3.List(x)) Then GoTo saut2
Next x
End If
ComboBox3.AddItem Cel.Offset(0, 2).Value
End If

saut2:
Next Cel



For F = 1 To UBound(tabtemp, 1)
If tabtemp(F, 1) = CLng(ComboBox1.Value) Then
ListBox1.AddItem tabtemp(F, 3)
ListBox2.AddItem tabtemp(F, 4)
ListBox3.AddItem tabtemp(F, 5)
ListBox4.AddItem tabtemp(F, 6)
ListBox5.AddItem tabtemp(F, 10)
End If
Next F

End Sub

Private Sub UserForm_Initialize()
Dim nom As New Collection
Dim item
Dim c As Range
Dim F As Variant
Dim i As Integer

L1 = Range('a65536').End(xlUp).Row
L2 = Range('B65536').End(xlUp).Row
L3 = Range('c65536').End(xlUp).Row

Set P1 = Range('a2:a' & L1)
Set P2 = Range('B2:B' & L2)
Set P3 = Range('c2:c' & L3)

ComboBox1.ListIndex = -1
ComboBox2.ListIndex = -1
ComboBox3.ListIndex = -1
ListBox1 = ''
ListBox2 = ''
ListBox3 = ''
ListBox4 = ''
ListBox5 = ''
TxtDate = ''
TxtAchete = ''
TxtPrix = ''

With Worksheets('Feuil1')
For Each Cel In P1
If ComboBox1.ListCount > 0 Then
For x = 0 To ComboBox1.ListCount - 1
If Cel.Value = ComboBox1.List(x) Then GoTo suite
Next x
End If
ComboBox1.AddItem Cel.Value
suite:
Next Cel

For Each Cel In P2
If ComboBox2.ListCount > 0 Then
For x = 0 To ComboBox2.ListCount - 1
If Cel.Value = ComboBox2.List(x) Then GoTo suite2 'la boucle débute ici
Next x 'la boucle se termine ici
End If
ComboBox2.AddItem Cel.Value
suite2:
Next Cel

For Each Cel In P3
If ComboBox3.ListCount > 0 Then
For x = 0 To ComboBox3.ListCount - 1
If CStr(Cel.Value) = CStr(ComboBox3.List(x)) Then GoTo suite3
Next x
End If
ComboBox3.AddItem Cel.Value
Debug.Print Cel.Value
suite3:
Next Cel

Cmb2.Enabled = False
Cmb3.Enabled = False
End With
End Sub

Merci

Message édité par: Cougar, à: 08/08/2005 05:13

 

[Bebere]

bonjour Cougar,le Forum

un extrait de fichier avec ton usf -de 50k nom simple.zip

à+ 🙂

 

[Cougar]

Bonjour Bebere, le forum,

Effectivement il en serait plus simple tel que demandé.

Donc voici le fichier.

Merci. [file name=Combobox_20050808133049.zip size=46199]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Combobox_20050808133049.zip[/file]

 

[Bebere]

bonjour Cougar
si tu as besoin d'un coup de main
pour le reste, un peu d'explications seraient les bienvenues
à+ [file name=ComboboxRet.zip size=49446]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/ComboboxRet.zip[/file]

 

[Bebere]

bonjour Cougar
comme il pleuvait je me suis amusé un peu
je crois que c'est plus ce que tu cherches
à+ B)

 

[Cougar]

Bonsoir Bebere, le forum,

Wow, tout un ménage.

J'essai de modifier le code pour lorsque je sélectionne une valeur en A, seulement les valeur en B ayant une valeur en A doit être disponible et de même pour C (avec valeur en B). Lorsque les 3 combo sont remplis (il est possible que A soit vide mais pas B ni C), les listbox doivent être remplis des info. qui se trouvent en D, E, F, G et K.

Je te reviens car j'aurais sûrement des problèmes pour cela.

Merci