Discussion :

[apt]

Bonsoir à tous,

Pour alimenter une ListBox et deux ComboBox, j'utilise la même façon pour faire cela :

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Private Sub UserForm_Initialize()
 
    Dim myDico As Object, myDico1 As Object, myDico2 As Object
    Dim i As Long, j As Long, nbLignes As Long
    Dim tabStr As Variant, tmpStr As String
    Dim tabStr1 As Variant, tmpStr1 As String
    Dim tabStr2 As Variant, tmpStr2 As String
    T = Timer()
 
  '-- ListBox1 : Colonne A
    Set myDico = CreateObject("Scripting.Dictionary")
 
    'enlever les doublons
    With ThisWorkbook.Sheets("BD")
        nbLignes = .Range("A" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        For i = 3 To nbLignes
            myDico.Add .Range("A" & i).Text, .Range("A" & i).Text
        Next i
        On Error GoTo 0
    End With
 
    tabStr = myDico.Items
 
    'trier la liste
    For i = LBound(tabStr) To UBound(tabStr) - 1
        For j = i + 1 To UBound(tabStr)
            If tabStr(j) < tabStr(i) Then
                tmpStr = tabStr(j)
                tabStr(j) = tabStr(i)
                tabStr(i) = tmpStr
            End If
        Next j
    Next i
 
    'afficher la liste dans le controle
    Me.ListBox1.List = tabStr
 
'-- ComboBox1 : Colonne B
       Set myDico1 = CreateObject("Scripting.Dictionary")
 
    'enlever les doublons
    With ThisWorkbook.Sheets("BD")
        nbLignes = .Range("B" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        For i = 3 To nbLignes
            myDico1.Add .Range("B" & i).Text, .Range("B" & i).Text
        Next i
        On Error GoTo 0
    End With
 
    tabStr1 = myDico1.Items
 
    'trier la liste
    For i = LBound(tabStr1) To UBound(tabStr1) - 1
        For j = i + 1 To UBound(tabStr1)
            If tabStr1(j) < tabStr1(i) Then
                tmpStr1 = tabStr1(j)
                tabStr1(j) = tabStr1(i)
                tabStr1(i) = tmpStr1
            End If
        Next j
    Next i
 
    'afficher la liste dans le controle
    Me.ComboBox1.List = tabStr1
 
'-- ComboBox2 : Colonne F
   Set myDico2 = CreateObject("Scripting.Dictionary")
 
    'enlever les doublons
    With ThisWorkbook.Sheets("BD")
        nbLignes = .Range("F" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        For i = 3 To nbLignes
            myDico2.Add .Range("F" & i).Text, .Range("F" & i).Text
        Next i
        On Error GoTo 0
    End With
 
    tabStr2 = myDico2.Items
 
    'trier la liste
    For i = LBound(tabStr2) To UBound(tabStr2) - 1
        For j = i + 1 To UBound(tabStr2)
            If tabStr2(j) < tabStr2(i) Then
                tmpStr2 = tabStr2(j)
                tabStr2(j) = tabStr2(i)
                tabStr2(i) = tmpStr2
            End If
        Next j
    Next i
 
    'afficher la liste dans le controle
    Me.ComboBox2.List = tabStr2
 
    MsgBox "Temp1 = " & Timer() - T
End Sub

Mais j'aimerais optimiser et réduire les lignes de ce code.

Merci d'avance.

[mercatog]

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
Option Explicit
 
Private Sub Remplir(ByVal LST, ByVal Col As Integer)
Dim myDico As Object
Dim i As Long, j As Long, nbLignes As Long
Dim tabStr As Variant, tmpStr As String
 
 
Set myDico = CreateObject("Scripting.Dictionary")
 
'enlever les doublons
With ThisWorkbook.Sheets("BD")
    nbLignes = .Cells(.Rows.Count, Col).End(xlUp).Row
    For i = 3 To nbLignes
        If Not myDico.exists(.Cells(i, Col).Text) Then myDico.Add .Cells(i, Col).Text, .Cells(i, Col).Text
    Next i
End With
tabStr = myDico.Items
Set myDico = Nothing
 
'trier la liste
For i = LBound(tabStr) To UBound(tabStr) - 1
    For j = i + 1 To UBound(tabStr)
        If tabStr(j) < tabStr(i) Then
            tmpStr = tabStr(j)
            tabStr(j) = tabStr(i)
            tabStr(i) = tmpStr
        End If
    Next j
Next i
 
'afficher la liste dans le controle
LST.List = tabStr
End Sub
 
 
Private Sub UserForm_Initialize()
 
Remplir Me.ListBox1, 1                             'On remplit ListBox1 par les données de la colonne 1(A)
Remplir Me.ComboBox1, 2                            'On remplit ListBox1 par les données de la colonne 2(B)
Remplir Me.ComboBox2, 6                            'On remplit ListBox1 par les données de la colonne 6(F)
End Sub

[apt]

Merci mercatog