Erreur 13 lors d'une tentative de suppression de doublons d'une listbox

**Michel Delapouaitte** · 08/04/2009, 12h02

Bonjour à tous.

J'ai un problème on-ne-peut-plus bizarre, et j'ai eu beau parcourir tous les forums et tutos et tester moult solutions proposées, je ne m'en sors pas :

J'ai un fichier excel97 qui comporte 3 feuilles (ici seules les feuilles 1 et 3 nous intéressent, mais bon je le mentionne au cas où).
Lorsque l'utilisateur ouvre la Feuil3, un Userform apparait. Ce Userform a 4 listbox qui sont alimentées par le parcours des colonnes de la feuil1 qui m'intéressent (une listbox = 1 colonne).

J'en suis à supprimer les doublons dans ces listbox, et j'ai bien trouvé des codes le faisant à foison. Mais je n'ai même pas eu le loisir de les tester puisqu'une erreur 13 ( = incompatibilité de type) survient. J'ai cherché la localisation de l'objet mais il est dans la librairie F3Dynamic qui n'est pas référencée, et elle est introuvable.

Aidez-moi svp.

**laetitia** · 08/04/2009, 12h34

bonjour Michel Delapouaitte le forum tu dois avoir une variable mal declaree essai de mettre en variant pour voir si meme pb..
autrement 2 exemples un avec New Collection l autre avec CreateObject("Scripting.Dictionary")
le nom de la listbox=cbx1 tester sous excel2003 & 2007 ok pour excel 97 pas teste

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
Dim T, z As Variant, l As Collection, X As Long, i As Long
On Error Resume Next
Set l = New Collection
T = Range("A2:a" & Range("A65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
cbx1.AddItem z: Next
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub test5()
Dim T, z As Variant, l As Object, X As Long, i As Long
On Error Resume Next
Set l = CreateObject("Scripting.Dictionary")
T = Range("A2:a" & Range("A65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
If z <> "" Then cbx1.AddItem z
 Next
End Sub

**Michel Delapouaitte** · 08/04/2009, 14h06

Bonjour Laetitia, et merci de ton aide (J'ai pu voir ici-même à de multiples reprises qu'elle était très précieuse).

J'ai essayé avec les 2 exemples que tu donnes, en adaptant juste la plage, mais ils n'ont aucune incidence sur le résultat. Peut-être que je ne les appelle pas au bon endroit. (J'ai attaqué le VBA seulement lundi pour mon stage, du coup j'suis un peu un noob dans ce langage

).

Je te mets mon code pour que tu puisses me dire si c'est moi qui fais nimp.
Je mets un 'PouetPouet' à chaque endroit d'où j'ai essayé de placer les appels de tes exemples.
Je vais mettre en plus la methode SupDoubles que j'essaie d'utiliser.

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
Private Sub UserForm_Initialize()
 
 
 
With Sheets(1)
 
'On initialise les listes selon les colonnes qui nous interessent,
'avec seulement les lignes contenant des donnees
   '(@Laetitia : les 10 premieres lignes n'ont pas de donnees)
'entreprise client
    ListBox1.List = .Range("D10:D" & .Range("D65536").End(xlUp).Row).Value
' ----------> PouetPouet !!! <-----------
'   SupDoubles ListBox1
'nom du collaborateur dans l'entreprise cliente
    ListBox2.List = .Range("E10:E" & .Range("E65536").End(xlUp).Row).Value
'    SupDoubles ListBox2
'Responsable
    ListBox3.List = .Range("F10:F" & .Range("F65536").End(xlUp).Row).Value
'    SupDoubles ListBox3
'Site (=agence)
    ListBox4.List = .Range("L10:L" & .Range("L65536").End(xlUp).Row).Value
'    SupDoubles ListBox4
 
 
End With
'----------> PouetPouet !!! <-----------
End Sub

La methode SupDoubles :

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
Private Sub SupDoubles(lst As ListBox)
    Dim iPos As Integer
    iPos = 0
    'Si la listbox est vide il quitte la fonction
    If lst.ListCount < 1 Then Exit Sub
    Do While iPos < lst.ListCount
        lst.Text = lst.List(iPos)
        'Verifie si le text existe deja
        If lst.ListIndex <> iPos Then
            'Si c'est le cas il supprime et garde la position iPos...
            lst.RemoveItem iPos
        Else
            'Si ce n'est pas le cas il change la position iPos...
            iPos = iPos + 1
        End If
    Loop
    'Utilisé pour désélectionner la dernière ligne
    lst.Text = "-"
End Sub

Le déboguer me localise l'erreur sur l'appel de SupDoubles. J'ai essayé diverses variantes (Userform1.Listbox1 , Listbox1.list , le melanges des 2, etc).

Plus étrange, j'avais aussi essayé de ne pas mettre mon code dans une methode mais directement après l'alimentation (à la place de l'appel), ce qui aurait au moins eu le mérite de marcher, à défaut d'être propre. Dans ce cas l'erreur est directement sur le "Listbox1 = " (ou les variantes testées) alors qu'une ligne au-dessus, pour l'alimentation y'a pas de soucis il le connait bien le listbox1.

**laetitia** · 08/04/2009, 17h31

re essai comme cela

Option Explicit

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
Private Sub UserForm_Initialize()
 Dim Cell As Range, Unique As New Collection, Valeur As Range, i As Integer
 With Sheets(1)
 i = .Range("d65536").End(xlUp).Row
 On Error Resume Next
 For Each Cell In .Range("d10:d" & i)
 Unique.Add Cell, CStr(Cell)
 Next Cell
 On Error GoTo 0
 For Each Valeur In Unique
 ListBox1.AddItem Valeur
 Next Valeur
i = .Range("e65536").End(xlUp).Row
On Error Resume Next
 For Each Cell In .Range("e10:e" & i)
 Unique.Add Cell, CStr(Cell)
 Next Cell
 On Error GoTo 0
 For Each Valeur In Unique
 ListBox2.AddItem Valeur
 Next Valeur
i = .Range("f65536").End(xlUp).Row
On Error Resume Next
 For Each Cell In .Range("f10:f" & i)
 Unique.Add Cell, CStr(Cell)
 Next Cell
 On Error GoTo 0
 For Each Valeur In Unique
 ListBox3.AddItem Valeur
 Next Valeur
i = .Range("l65536").End(xlUp).Row
On Error Resume Next
 For Each Cell In .Range("l10:l" & i)
 Unique.Add Cell, CStr(Cell)
 Next Cell
 On Error GoTo 0
 For Each Valeur In Unique
 ListBox4.AddItem Valeur
 Next Valeur
End With
End Sub

**Qwazerty** · 08/04/2009, 18h01

Salut
Lut Leti

En conservant tout le code d'origine, il suffit de modifier As ListBox par As Objet.
Pour desélectionner une ligne dans un listbox (ou combobox aussi) il faut attribuer a ListIndex (ItemIndex pour le combobox) la valeur -1.

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
Private Sub SupDoubles(lst As Object)
    Dim iPos As Integer
    iPos = 0
    'Si la listbox est vide il quitte la fonction
    If lst.ListCount < 1 Then Exit Sub
    Do While iPos < lst.ListCount
        lst.Text = lst.List(iPos)
        'Verifie si le text existe deja
        If lst.ListIndex <> iPos Then
            'Si c'est le cas il supprime et garde la position iPos...
            lst.RemoveItem iPos
        Else
            'Si ce n'est pas le cas il change la position iPos...
            iPos = iPos + 1
        End If
    Loop
    'Utilisé pour désélectionner la dernière ligne
    'lst.Text = "-"
    lst.ListIndex = -1
End Sub

A++
Qwaz

**Michel Delapouaitte** · 08/04/2009, 22h21

Merci beaucoup à vous 2 pour votre temps et votre aide. J'ai pas encore pu tester vos solutions car j'ai pas XL97 chez moi (j'suis noob en VBA mais pas maso) et c'est justement la version dans l'entreprise où j'effectue mon stage qui est le principal frein à mon avancée. Je vous aurais pas embêté sinon.

J'ai trouvé un autre bout de code juste avant de quitter le boulot mais j'ai pas eu le temps de le tester et là comme ça de tête je peux pas vous le réécrire sans faire d'erreurs ou du moins en étant sûr de pas en faire.
Il m'avait l'air pas mal : simple et efficace (KISS comme disent les anciens) et en plus il triait par ordre alpha en plus de supprimer les doublons.

Je teste et vous en dis plus demain.
Bonne fin de soirée et encore merci.

**Michel Delapouaitte** · 09/04/2009, 08h19

Re.

Le code de Qwaz marche bien, mais comme je vous le disais j'en ai trouvé un qui en plus me trie les entrées de la listox par ordre alpha (

), du coup plutôt que d'essayer de faire une autre methode pour trier, je vais utiliser celle qui fait les 2 pour éviter de galérer encore sur le tri.

Je vous met le code que j'ai trouvé (désolé je me souviens plus de l'endroit où je l'ai chopé, j'en ai testé tellement ... Mais il n'est pas de moi

)

On passe donc par un tableau tampon dans lequel on trie par ordre alpha, puis on insère les valeurs du tableau dans la listbox, sans insérer les valeurs qui y sont déjà :

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
Dim Tablo As Variant, Tempo As Variant, i As Long, j As Long
    Worksheets("BASE").Activate 'à défaut d'instancier la feuille
    Tablo = Range("d10:d" & Range("d" & Rows.Count).End(xlUp).Row).Value
'triAlpha
    For i = 1 To UBound(Tablo)
        For j = 1 To UBound(Tablo)
            If Tablo(i, 1) < Tablo(j, 1) Then
                Tempo = Tablo(i, 1)
                Tablo(i, 1) = Tablo(j, 1)
                Tablo(j, 1) = Tempo
            End If
        Next j
    Next i
'Remplissage excluant les doublons
    ListBox1.AddItem Tablo(1, 1)
    For i = 2 To UBound(Tablo)
        If Tablo(i, 1) <> Tablo(i - 1, 1) Then ListBox1.AddItem Tablo(i, 1)
    Next

Merci beaucoup à tous les 2 de votre aide ô combien rapide et efficace.

EDIT : J'ai crié victoire un peu tôt. En effet j'ai mis mon code dans une méthode que j'appelle dans l'initialize.
Mais allez savoir pourquoi, ça marche pas pour le premier appel alors que ça marche bien pour les autres.

Le proto : Private Sub AlimList(lst As Object, ByVal Target As Excel.Range)

L'initialize :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Initialize()
 
    With Sheets(1)
        AlimList ListBox1, Range("D10:D" & Range("D" & Rows.Count).End(xlUp).Row)
        AlimList ListBox2, Range("E10:E" & Range("E" & Rows.Count).End(xlUp).Row)
        AlimList ListBox3, Range("F10:F" & Range("F" & Rows.Count).End(xlUp).Row)
        AlimList ListBox4, Range("L10:L" & Range("L" & Rows.Count).End(xlUp).Row)
    End With
 
 
End Sub

Ca marche nikel pour les listbox 2 à 4 mais rien du tout dans la 1, alors qu'elle est strictement identique aux autres.

**laetitia** · 09/04/2009, 13h34

re,bonjour un code qui marche sous excel 2003 & 2007 sous excel 97 ???c est du brute l ami Qwazerty aura bien une solution pour trouver une boucle pour simplifier tous ca

les listboxs se nomment cbx1,cbx2 ect...
Option Explicit

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
Private Sub UserForm_Initialize()
 Dim T, z As Variant, l As Object, i As Long, j As Long, temp As String
On Error Resume Next
Set l = CreateObject("Scripting.Dictionary")
T = Range("d10:d" & Range("d65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
cbx1.AddItem z: Next
For i = 0 To cbx1.ListCount - 1
For j = 0 To cbx1.ListCount - 1
If cbx1.List(i) < cbx1.List(j) Then
temp = cbx1.List(i)
cbx1.List(i) = cbx1.List(j)
cbx1.List(j) = temp
End If: Next j: Next i
 Set l = CreateObject("Scripting.Dictionary")
T = Range("e10:e" & Range("e65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
cbx2.AddItem z: Next
For i = 0 To cbx2.ListCount - 1
For j = 0 To cbx2.ListCount - 1
If cbx2.List(i) < cbx2.List(j) Then
temp = cbx2.List(i)
cbx2.List(i) = cbx2.List(j)
cbx2.List(j) = temp
End If: Next j: Next i
Set l = CreateObject("Scripting.Dictionary")
T = Range("f10:f" & Range("f65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
cbx3.AddItem z: Next
For i = 0 To cbx3.ListCount - 1
For j = 0 To cbx3.ListCount - 1
If cbx3.List(i) < cbx3.List(j) Then
temp = cbx3.List(i)
cbx3.List(i) = cbx3.List(j)
cbx3.List(j) = temp
End If: Next j: Next i
Set l = CreateObject("Scripting.Dictionary")
T = Range("l10:l" & Range("l65536").End(xlUp).Row)
For i = LBound(T) To UBound(T)
l.Add T(i, 1), T(i, 1): Next
For Each z In l
cbx4.AddItem z: Next
For i = 0 To cbx4.ListCount - 1
For j = 0 To cbx4.ListCount - 1
If cbx4.List(i) < cbx4.List(j) Then
temp = cbx4.List(i)
cbx4.List(i) = cbx4.List(j)
cbx4.List(j) = temp
End If: Next j: Next i
End Sub

edit j ai oublie de marquer la feuille autrement de la feuille 3 pas marcher
T = Sheets(1).Range("d10:d" & Range("d65536").End(xlUp).Row)
T = Sheets(1).Range("e10:e" & Range("e65536").End(xlUp).Row)
ect...

**Michel Delapouaitte** · 09/04/2009, 14h02

Bien le bonjour à toi !

Pas encore testé ton coede par contre j'ai changé l'ordre des appels à AlimList et y'a bien que la listbox concernée par le premier appel qui reste vide. Je comprends pas trop pourquoi mais je vais tenter de faire le premier appel sur une listbox bidon qui sera pas affichée, pour voir si ça marche.

Je te donne le verdict juste après et si c'est toujours pas bon, je testerai ta solution (pour laquelle je te remercie encore).

Le fait est que je n'ai que jusqu'à demain pour finir cette appli donc je préfère fouiller au max une solution qui ma foi a l'air de fonctionner (à part ce petit truc bizarre) pour pas perdre de temps. Ton aide est malgré tout précieuse et tes suggestions fort utiles.

**Michel Delapouaitte** · 09/04/2009, 14h29

Ca marche !!!!

Je confirme donc, y'a que sur la listbox du premier appel que ça fait rien, du coup en passant au premier appel une listbox de débug non affichée celles qui sont censées être alimentées le sont.

Merci infiniement pour votre aide, Laeti & Qwaz !

**Qwazerty** · 09/04/2009, 14h36

Salut, Leti, Michel

Il faudrait voir le code de ta function alimList, la solution a ton problème s'y trouve certainement.
A++
Qwaz

**Michel Delapouaitte** · 15/04/2009, 11h28

Oups pardon du retard, j'avais pas vu ta réponse Qwaz.
Je mets le code de la fonction AlimList (qui est en fait celle que je disais avoir trouvée sur le net), et je passe le sujet en résolu vu qu'à part ce petit bug ça marche bien, du coup pas la peine de vous prendre la tête dessus.

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
'alimente une listbox lst à partir d'une plage de la feuil1 ("BASE") Target
Private Sub AlimList(lst As Object, ByVal Target As Excel.Range)
 
Dim tablo As Variant, Tempo As Variant, i As Long, j As Long
    Worksheets("BASE").Activate  'à défaut d'instancier la feuille
    tablo = Target.Value
'triAlpha
    For i = 1 To UBound(tablo)
        For j = 1 To UBound(tablo)
            If tablo(i, 1) < tablo(j, 1) Then
                Tempo = tablo(i, 1)
                tablo(i, 1) = tablo(j, 1)
                tablo(j, 1) = Tempo
            End If
        Next j
    Next i
'Remplissage excluant les doublons
    lst.AddItem tablo(1, 1)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) <> tablo(i - 1, 1) Then lst.AddItem tablo(i, 1)
    Next
    lst.ListIndex = -1
End Sub

Voilà. encore merci pour votre aide. D'ailleurs si vous avez du temps à tuer j'ai un autre problème, donc j'ai créé un autre thread :
ici

Erreur 13 lors d'une tentative de suppression de doublons d'une listbox [XL-97]

Macros et VBA Excel

Discussions similaires

Partager

Partager