Optimisation boucle VBA

Bonjour,

Je reviens vers vous, expert vba, pour quelques conseils, j'espère que vous pourrez me guider. Jusque là j'ai énormément appris à vos côtés j'espère en apprendre encore beaucoup aujourd'hui.

Je souhaite réaliser un userform avec une liste déroulante avec des informations filtrés en fonction que d'un champ extérieur.

Ma contrainte principale étant que j'ai une grande quantité de lignes à balayer pour remplir mon combobox.

Mon code fonctionne mais est relativement long d'exécution. J'ai trouvé tout un tas de topic sur le sujet, malgré une amélioration notable je reste à une dizaine de seconde d'execution. J'ai cru comprendre qu'il était possible d'analyser des milliers de lignes en peu de temps.

Je vous mets en pj un extrait de mon problème. et voici l'extrait de mon code:

Sub runbdd()
Dim start As Single
start = Timer
Run ("ss")

UserForm1.Show
MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub
Private Sub ss()
Dim cel As Range
Dim i As Long
Dim fin As Integer

'For Each cel3 In fl.Range("B2:B" & fin) 'fl.Range("8685").End(xlUp).Row)
'        If cel3 = "CROI39-NI" Then
'            For y = 0 To UserForm1.ComboBox12.ListCount - 1
'                If cel3.Offset(0, 5).Value = UserForm1.ComboBox12.List(y) Then
'                GoTo Apsui
'                End If
'            Next y
'        End If
'    UserForm1.ComboBox12.AddItem cel3.Offset(0, 5).Value
'Apsui:
'    Next cel3

'/Définition dans cette configuration (valeur donnée de cb) des valeurs spécifique de cb, références des pièces
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
    If Cells(i, "B").Value <> "CROI39-NI" Then
    GoTo suivant
    Else
        For y = 0 To UserForm1.ComboBox1.ListCount - 1
            If Cells(i, "G").Value = UserForm1.ComboBox1.List(y) Then
            GoTo suivant
            End If
        Next y
    UserForm1.ComboBox1.AddItem Cells(i, "G").Value
    End If
suivant:
Next i

End Sub

Je voulais savoir si vous pouviez me donner des conseils ciblés pour optimiser.

Bonjour Sarfate, bonjour le forum,

Ceci pourrait-il te convenir ?

Private Sub ss()
Dim i As Long

For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
    If Cells(i, "B").Value = "CROI39-NI" Then UserForm1.ComboBox1.AddItem Cells(i, "G").Value
Next i

End Sub

A+

Joseph

Bonsoir,

à premier coup d’œil, les 'GoTo suivant' me dérangent...

je regarde mieux le fichier.

Bonsoir à tous !

Réaménagement :

Public start As Single

Sub runbdd()
    start = Timer
    UserForm1.Show
End Sub

NB- Tu pourras supprimer ce qui concerne ta mesure du temps d'exécution...

edit : je remplace la proc: inattention de ma part la fin doit rester sous la condition... (fichier remplacé aussi)

Private Sub UserForm_Initialize()
    Dim d As Object, n%, c As Range, Tbl
    With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Range("A2:L" & n).Sort key1:=.Range("B2"), order1:=xlAscending, _
         key2:=.Range("G2"), order2:=xlAscending, Header:=xlNo
        Set c = .Columns("B").Find("CROI39-NI", , , xlWhole)
    End With
    If Not c Is Nothing Then
        Set d = CreateObject("Scripting.Dictionary"): i = 1
        With c
            Do
                d(.Cells(i, 6).Value) = ""
                i = i + 1
            Loop While .Cells(i, 1) = .Value
        End With
        Tbl = d.keys
        If d.Count > 1 Then
            ComboBox1.List = Tbl
        Else
            ComboBox1.AddItem Tbl(0)
        End If
    End If
    MsgBox "durée du traitement: " & Timer() - start & " secondes"
End Sub

Cordialement.

Merci à vous tous,

je me rend compte à quel point je peux me compliquer la vie.

merci pour votre réactivité.

Je vais me pencher sur ce que tu as écris Mferrand. Mais pour l'instant ca roule à 0,043 seconde au lieu de 8 secondes... vous êtes des chefs.

Re,

très bonne solution, MFerrand.

Une version différente, et plus lente...

Private Sub UserForm_Initialize()
    Dim a As String
    Dim n As Long
    Dim li As Long
    Dim doublon As Long
    Dim tableau() As String
    Dim plageCel As Range
    Dim Result As Range
    x = 0
    n = Cells(Rows.Count, 2).End(xlUp).Row
    a = "CROI39-NI"
    Set plageCel = Range(Cells(2, 2), Cells(n, 2))
    i = Application.CountIf(plageCel, a)
    If i > 0 Then
        ReDim tableau(i - 1)
        li = plageCel.Find(a, LookIn:=xlValues).Row - 1
        On Error GoTo sortir
            For Each Result In Range(Cells(li, 2), Cells(n, 2))
                If Result.Value = a Then
                        b = Cells(Result.Row, 7)
                        For y = 0 To x
                            If tableau(y) = "" Then Me.ComboBox1.AddItem b: tableau(x) = b: x = x + 1: Exit For
                            If tableau(y) = b Then Exit For 'doublon = doublon + 1: Exit For
                        Next y
                End If
            Next
    End If
sortir:
    fin = Timer - start
End Sub