Discussion :

[Frank]

Bonjour à tous,

le chargement de mon userform prend énormement de temps. il est constitué d'une listbox qui est alimentée par un fichier d'environ 2800 lignes, et de 3 combobox qui sont elles même alimentées par des colonnes de ce fichier source.

le chargement de la listbox est instantanée. Quand je rajoute la 1ere combobox, là on tourne à environ 20 secondes de chargement.
Avec la listbox et 2 combobox, là on passe allègrement la minute, et avec les 3 combobox cela prend plusieurs minutes.

Les trois combobox sont liées entre elles: la sélection sur la première définit le contenu de la suivante et ainsi de suite.
ci-dessous le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Option Explicit
 
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim NoAction As Boolean
 
 
Private Sub UserForm_Initialize()
    'Définit la feuille contenant les données
    Set Ws = Worksheets("Etat")
    'Définit le nombre de lignes dans la colonne A
    NbLignes = Ws.Range("A65536").End(xlUp).Row
 
    'Remplissage du ComboBox1
    Alim_Combo 1
 
End Sub
 
 
Private Sub ComboBox1_Change()
    'Remplissage Combo2
    Alim_Combo 2, ComboBox1.Value
End Sub
 
 
Private Sub ComboBox2_Change()
    'Remplissage Combo3
    Alim_Combo 3, ComboBox2.Value
End Sub
 
 
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
Dim j As Integer
Dim Obj As Control
 
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    Obj.Clear
    NoAction = True
 
    'alimentation 1ere combobox
    If CbxIndex = 1 Then
        For j = 5 To NbLignes
            Obj = Ws.Range("F" & j)
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("F" & j)
        Next j
    'alimentation 2eme combobox
    ElseIf CbxIndex = 2 Then
        For j = 5 To NbLignes
            If Ws.Range("F" & j) = Cible Then
            Obj = Ws.Range("G" & j)
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("G" & j)
            End If
        Next j
    'alimentation 3eme combobox
    ElseIf CbxIndex = 3 Then
        For j = 5 To NbLignes
           If Ws.Range("G" & j) = Cible Then
            Obj = Ws.Range("C" & j)
            If Obj.ListIndex = -2 Then Obj.AddItem Ws.Range("C" & j)
            End If
        Next j
 
    End If
    On Error Resume Next
    Obj.ListIndex = 0
    On Error GoTo 0
    NoAction = False
 
End Sub

je dois avouer que je tourne en rond.

j'ai refait plusieurs fois le code source, pour finalement récupérer le code source trouvé sur le forum. Rien n'y fait, c'est toujours aussi lent.
je pense que le problème vient de la source de données, mais je ne peux pas diminuer le nombre de lignes ni le nombre de colonnes.

je souhaite bien sur que le userform s'affiche instantané au lancement et qu'il soit prêt à l'usage.

Si quelqu'un a une idée, je suis preneur !

Une bonne année à tous

[boisgontierjacques]

Bonjour,


C'est un bon exemple de ce qu'il ne faut pas faire:
-Additem est lent
-Le test doublon est lent
En PJ , un exemple de combobox sans doublons avec 10.000 lignes dans la BD (0,015 sec).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)  ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
   If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  Me.ComboBox1.List = mondico.keys
End Sub

Avec Tri

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)  ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
   If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  '--avec tri
  temp = mondico.keys
  Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox1.List = temp
End Sub

Boisgontier

[Frank]

Bonjour BoisGontier,

merci pour le code, je vais l'intégrer à mon programme et je reviens vers vous tous pour vous informer du gain de temps réalisé.

Cdt,
Frank

[boisgontierjacques]

Sous forme de fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Option Compare Text
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Dim a()
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Me.ComboBox1.List = SansDoublonsMAC(a())
End Sub
 
Function SansDoublonsMAC(a())
   Dim Maliste As New Collection
   On Error Resume Next
   For i = LBound(a) To UBound(a)
     Maliste.Add Item:=a(i), key:=a(i)
   Next i
   On Error GoTo 0
   Dim b(): ReDim b(1 To Maliste.Count)
   For i = 1 To Maliste.Count
     b(i) = Maliste(i)
   Next i
   SansDoublonsMAC = Application.Transpose(b)
End Function

Boisgontier