Bonjour,
Ce code fonctionne avec des listbox en cascade mais il est tres lourd.
Comment pourrait on améliorer la durée d’exécution?
Bonne journée à tous
Dim N1 As Byte
Dim N2 As Byte
Dim N3 As Byte
Dim N4 As Byte
Dim N5 As Byte
Dim N6 As Byte
Dim Associe1 As String
Dim Associe2 As String
Dim Associe3 As String
Dim Associe4 As String
Dim Associe5 As String
Dim Associe6 As String
Dim Associe As String
Dim Ligne As Integer
Application.ScreenUpdating = False
Feuil4.Range("B1:BZ10000").ClearContents
For N1 = 1 To ListBox6.ListCount
On Error Resume Next
ListBox6.ListIndex = N1 - 1
If ListBox6.ListCount > 0 Then Associe1 = ListBox6.List(N1 - 1)
For N2 = 1 To ListBox7.ListCount
ListBox7.ListIndex = N2 - 1
If ListBox7.ListCount > 0 Then Associe2 = ListBox7.List(N2 - 1)
If ListBox8.ListCount = 0 Then
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1 + 1) = Associe1 & "/" & Associe2
ListBox12.AddItem Associe1 & "/" & Associe2
If N2 = ListBox7.ListCount Then GoTo suite1 Else GoTo suite2
End If
For N3 = 1 To ListBox8.ListCount
ListBox8.ListIndex = N3 - 1
If ListBox8.ListCount > 0 Then Associe3 = ListBox8.List(N3 - 1)
If ListBox9.ListCount = 0 Then
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1) = Associe1 & "/" & Associe2 & "/" & Associe3
ListBox12.AddItem Associe1 & "/" & Associe2 & "/" & Associe3
If N3 = ListBox8.ListCount Then GoTo suite2 Else GoTo suite3
End If
For N4 = 1 To ListBox9.ListCount
ListBox9.ListIndex = N4 - 1
If ListBox9.ListCount > 0 Then Associe4 = ListBox9.List(N4 - 1)
If ListBox10.ListCount = 0 Then
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1) = Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4
ListBox12.AddItem Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4
If N4 = ListBox9.ListCount Then GoTo suite3 Else GoTo suite4
End If
For N5 = 1 To ListBox10.ListCount
ListBox10.ListIndex = N5 - 1
If ListBox10.ListCount > 0 Then Associe5 = ListBox10.List(N5 - 1)
If ListBox10.ListCount = 0 Then
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1) = Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4 ' & "/" & Associe5
ListBox12.AddItem Associe1 & "/" & Associe2 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4
If N5 = ListBox10.ListCount Then GoTo suite4 Else GoTo suite5
Else
If ListBox11.ListCount = 0 Then
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1) = Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4 & "/" & Associe5
ListBox12.AddItem Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4 & "/" & Associe5
If N5 = ListBox10.ListCount Then GoTo suite4 Else GoTo suite5
End If
For N6 = 1 To ListBox11.ListCount
ListBox11.ListIndex = N6 - 1
Associe6 = ListBox11.List(N6 - 1)
Feuil4.Range("B" & Feuil4.Range("B6500").End(xlUp).Row + 1) = Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4 & "/" & Associe5 & "/" & Associe6
ListBox12.AddItem Associe1 & "/" & Associe2 & "/" & Associe3 & "/" & Associe4 & "/" & Associe5 & "/" & Associe6
Next N6
End If
suite5:
Next N5
suite4:
Next N4
suite3:
Next N3
suite2:
Next N2
suite1:
Next N1
Unload Me
Feuil4.Select
Application.ScreenUpdating = True
Voici le code qui alimente la listbox suivante, ici la Listbox7 qui alimente la listbox8 :
Private Sub ListBox7_Click()
Dim I As Byte
Dim tabN2(40, 1)
Dim K As Byte
Dim Foundcell As Range
K = 0
Dim p As Byte
For p = 8 To 11
Controls("Listbox" & p).Clear
Next p
For I = 1 To 40
If Cells(ListBox7.List(ListBox7.ListIndex, 1), 6 + I).Value = "" Then GoTo Suite
If Cells(ListBox7.List(ListBox7.ListIndex, 1), 6 + I).Value = Label5.Caption Then GoTo suite1
If Cells(ListBox7.List(ListBox7.ListIndex, 1), 6 + I).Interior.Color = vbGreen Then
Set Foundcell = Range("A2:A" & Range("A6500").End(xlUp).Row).Find(what:=Cells(ListBox7.List(ListBox7.ListIndex, 1), 6 + I).Value, LookAt:=xlWhole)
If Not Foundcell Is Nothing Then
K = K + 1
tabN2(K, 0) = Cells(ListBox7.List(ListBox7.ListIndex, 1), 6 + I).Value
tabN2(K, 1) = Foundcell.Row
End If
End If
suite1:
Next I
Suite:
For K = 1 To K
For Z = 1 To ListBox7.ListCount
If tabN2(K, 0) = ListBox7.List(Z - 1) Then
ListBox8.AddItem tabN2(K, 0)
ListBox8.List(ListBox8.ListCount - 1, 1) = tabN2(K, 1)
End If
Next Z
Next K
Label6.Caption = ListBox7.Value
End Sub