Doublons dans un ListBox
isaca
-
9 oct. 2001 à 11:56
cs_Duanra Messages postés 26 Date d'inscription samedi 22 février 2003 Statut Membre Dernière intervention 13 janvier 2005 - 1 juil. 2003 à 19:18
cs_Duanra Messages postés 26 Date d'inscription samedi 22 février 2003 Statut Membre Dernière intervention 13 janvier 2005 - 1 juil. 2003 à 19:18
A voir également:
- Doublons dans un ListBox
- Sql supprimer les doublons ✓ - Forum SQL
- Listbox delphi ✓ - Forum Delphi / Pascal
- Sql supprimer doublons - Forum SQL
- Sql ne pas afficher les doublons - Forum Visual Basic
- Mysql supprimer doublons ✓ - Forum PHP
4 réponses
Salut
A premiere vue
ton second if =""(celui dans la boucle) il n'ira jamais dedans.Puisque ta boucle est dedans un if <>"".Donc la fonction Fiche.FormaEffec.RemoveItem (Verif) n'est jamais exectue.
Place un point d'arret a l'interieur et tu verras si j'ai raison.
Bonne prog
@++ :)
A premiere vue
ton second if =""(celui dans la boucle) il n'ira jamais dedans.Puisque ta boucle est dedans un if <>"".Donc la fonction Fiche.FormaEffec.RemoveItem (Verif) n'est jamais exectue.
Place un point d'arret a l'interieur et tu verras si j'ai raison.
Bonne prog
@++ :)
À voir ton code je dirais qu'il doit planter souvent pour la simple raison que tu donne un nombre en entrée (Fiche.ListAbs.ListCount - 1) et que cette valeur change dynamiquement, donc ta boucle vas s'exécuter un trop grand nombre de fois (erreur #9 je crois).
Je peux avoir tord.
Sachant que les contrôles sont très lent, ma méthode préférée est de recopier les items dans un tableau de chaines et de faire le tri dans celle-ci.
Donc, si ça t'intéresse, voici comment:
Je peux avoir tord.
Sachant que les contrôles sont très lent, ma méthode préférée est de recopier les items dans un tableau de chaines et de faire le tri dans celle-ci.
Donc, si ça t'intéresse, voici comment:
'Prendre les items:
Dim iNbrEle As Integer
Dim iNbrEle2 As Integer 'Pour traces seulement
Dim iCmpt As Integer
Dim astrElements() As String
iNbrEle = List1.ListCount - 1
Redim astrElements(iNbrEle)
For iCmpt = 0 To iNbrEle
astrElements(iCmpt) = List1.List(iCmpt)
Next iCmpt
fctEnleverDoublons astrElements
'Traces...
iNbrEle2 = iNbrEle
'/Traces
iNbrEle = uBound(astrElements)
'Traces...
Msgbox Str$(iNbrEle2 - iNbrEle) & " éléments sur" & Str$(iNbrEle2) & " éliminés."
iNbrEle = iNbrEle2
'/Traces
List1.Clear
For iCmpt = 0 To iNbrEle
List1.AddItem astrElements(iCmpt)
Next iCmpt
'===================================
' fin
'===================================
Public Sub fctEnleverDoublons(ByRef Tableau1() As String, Optional ByVal Ordonner As Boolean)
'
' Prend un tableau de chaines et en retire les items en double.
'
Dim Compte As Long ' Nombre d'item dans la liste
Dim Cmpt1 As Long ' Boucle
Dim Cmpt2 As Long ' Boucle 2
Dim SepIndice As Integer ' Où est situé le ' :'
Dim NomItem As String ' Nom de l'item avec le ':'
Dim QtyItem As Single ' Currency 'Long ' Integer 'Nombre de l'item
Dim ChrRestants As Integer ' Pour éviter d'utiliser trop de fonctions, voir sa ligne d'initialisation
Compte = UBound(Tableau1)
'Pour chaque item distinct on recopie dans le même tableau à l'indice Cmpt2
For Cmpt2 = 0 To (Compte - 1)
'If Tableau1(Cmpt2) <> vbNullString Then 'Si cet item n'as pas déjà été compilé...
If (LenB(Tableau1(Cmpt2)) > 0) Then
' On compare l'item tableau1(Cmpt2) au reste de la liste.
For Cmpt1 = (Cmpt2 + 1) To Compte
If (StrComp(Tableau1(Cmpt1), Tableau1(Cmpt2), vbTextCompare) = 0) Then
Tableau1(Cmpt1) = vbNullString
'Else
End If
Next Cmpt1
End If
Next Cmpt2
'On enlève les éléments vides...
CompresserListeStr Tableau1 'call
'On met en ordre...
'If Ordonner Then BubbleSortAscii_2 Tableau1
End Sub
Public Sub CompresserListeStr(ByRef InListe() As String)
'
' InListe contient un tableau d'items dont certains
' peuvent être Null. Cette fonction recopie les items de
' façon à placer toutes les chaines vide à la fin et
' réduire la taille du tableau.
'
Dim Nombre As Long
Dim Cmpt As Long
Dim Cmpt2 As Long
Nombre = UBound(InListe)
'Compresser la liste en déplacant les items vers le haut...
Do While (Cmpt < Nombre)
If (InListe(Cmpt) <> vbNullString) Then
Cmpt = Cmpt + 1
Else
Cmpt2 = Cmpt
Do While ((InListe(Cmpt) = vbNullString) And (Cmpt < Nombre))
Cmpt = Cmpt + 1
Loop
InListe(Cmpt2) = InListe(Cmpt)
InListe(Cmpt) = vbNullString
If (Cmpt <> Nombre) Then Cmpt = Cmpt2 + 1
End If
Loop
'Trouver la première ligne blanche et couper.
Cmpt = -1
Cmpt2 = -1
Do While ((Cmpt < Nombre) And (Cmpt2 = -1))
Cmpt = Cmpt + 1
If InListe(Cmpt) vbNullString Then Cmpt2 Cmpt
Loop
If (Cmpt2 = -1) Then
'Cas "Aucun blanc"
Cmpt2 = Nombre
Else
'Cas au moins un blanc
Cmpt2 = Cmpt2 - 1
'Mais si rien dans liste, en principe impossible, forcer 0 pour éviter de planter
If (Cmpt2 < 0) Then Cmpt2 = 0
End If
ReDim Preserve InListe(Cmpt2)
End Sub
cs_Duanra
Messages postés
26
Date d'inscription
samedi 22 février 2003
Statut
Membre
Dernière intervention
13 janvier 2005
1 juil. 2003 à 19:18
1 juil. 2003 à 19:18
A ben, merci bien!
voila une épine qui me resort du pied!
merci, merci, merci!
Par contre j'ai dut supprimer les actions sur les traces pour que le code puisse tourner...
Duan
voila une épine qui me resort du pied!
merci, merci, merci!
Par contre j'ai dut supprimer les actions sur les traces pour que le code puisse tourner...
Duan
