Discussion :

[Yoshiblow]

Bonjours,

Le titre n'es peu être pas très parlant mais je actuellement entrain de développer une petite interface de séléction est j'aimerai savoir si il existe une commande toute faite pour vérifier si une valeur à dejà été ajouté dans une ListBox, mon code actuel est assez lourd et ce présente comme ci dessous :

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
Sub Groupe()
 
Set Acc = ThisWorkbook.Sheets("Acceuil")
Set BdD = ThisWorkbook.Sheets("BdD")
 
Dim i As Integer
Dim j As Integer
Dim GRP(100000) As Variant
 
Acc.LstGrp.Clear
 
ThisWorkbook.Sheets("BdD").Select
 
i = 3
 
Do Until IsEmpty(Cells(i, 1)) = True
 
    i = i + 1
 
Loop
 
iNblignes = i - 1
 
For i = 3 To iNblignes
 
    For j = 1 To iNblignes
 
        If BdD.Cells(i, 5) = GRP(j) Then GoTo Sortie
 
    Next j
 
    Acc.LstGrp.AddItem BdD.Cells(i, 5)
    GRP(i - 2) = BdD.Cells(i, 5)
 
Sortie:
 
Next i
 
Acc.Select
 
End Sub

J'utilise donc une itération ibriqué dans une autre pour vérifié si j'ai dejà ajouté la valeur. Ceci semble marcher pour un tableau assez petit mais j'arrive à 10303 lignes de donnée et je recontre beaucoup de problème que puis je utiliser comme fonction? Ou sinon mon code serait il mauvais?

Merci d'avance.

* Si je n'utilise pas la méthode Row.Count pour detecter la dernière ligne c'est juste une préférence personnelle.

[SilkyRoad]

bonsoir


Tu peux essayer cette adaptation (si j'ai bien compris)

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
Sub Groupe()
    Dim BdD As Worksheet
    Dim i As Integer
    Dim Unique As New Collection
    Dim Valeur As Range
 
    Set BdD = ThisWorkbook.Worksheets("BdD")
 
    ThisWorkbook.Worksheets("Accueil").LstGrp.Clear
    i = 3
 
    On Error Resume Next
    Do Until IsEmpty(BdD.Cells(i, 1)) = True
            'Stocke les données dans une collection
            '(La collection n'accepte que des données uniques et permet donc
            ' de filtrer facilement les doublons).
        Unique.Add BdD.Cells(i, 5), CStr(BdD.Cells(i, 5))
        i = i + 1
    Loop
    On Error GoTo 0
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        ThisWorkbook.Worksheets("Accueil").LstGrp.AddItem Valeur
    Next Valeur
End Sub

bone soirée
michel

[Yoshiblow]

Merci,

Le code est vraiment bien.