Urgent listbox
cs_revolt
Messages postés
68
Date d'inscription
samedi 5 mai 2001
Statut
Membre
Dernière intervention
15 mars 2015
-
14 févr. 2002 à 14:06
Makabey Messages postés 152 Date d'inscription mercredi 27 juin 2001 Statut Membre Dernière intervention 11 juillet 2002 - 14 févr. 2002 à 20:07
Makabey Messages postés 152 Date d'inscription mercredi 27 juin 2001 Statut Membre Dernière intervention 11 juillet 2002 - 14 févr. 2002 à 20:07
2 réponses
cs_Stephane
Messages postés
550
Date d'inscription
vendredi 5 janvier 2001
Statut
Membre
Dernière intervention
23 septembre 2006
14 févr. 2002 à 19:14
14 févr. 2002 à 19:14
salut
pour classer tu a la propriété sorted
et pour les doublons voila :
for a=0 to list1.listcount-1
for b=0 to list1.listcount-1
if a<>b and list1.list(a)=list1.list(b) then list1.removeitem b
next b
next a
voila normalement ca devrait marcher mé c'est pa trop optimisé
a+
pour classer tu a la propriété sorted
et pour les doublons voila :
for a=0 to list1.listcount-1
for b=0 to list1.listcount-1
if a<>b and list1.list(a)=list1.list(b) then list1.removeitem b
next b
next a
voila normalement ca devrait marcher mé c'est pa trop optimisé
a+
Makabey
Messages postés
152
Date d'inscription
mercredi 27 juin 2001
Statut
Membre
Dernière intervention
11 juillet 2002
1
14 févr. 2002 à 20:07
14 févr. 2002 à 20:07
Le code qui suit est de loin beaucoup plus compliqué, mais j'ai testé sur une liste de 759 items et j'arrive à 0.25 seconde comparé à 1.39 avec le code de stephane (sans rancune ;) )
Le code suppose qu'il y as une Listbox Source (remplie), une Listbox Destination et un Bouton,
si tu met la propriété Sorted de Source et/ou Destination à True, tu peux faire sauter la fonction BubbleSortAscii_2.
Le code suppose qu'il y as une Listbox Source (remplie), une Listbox Destination et un Bouton,
si tu met la propriété Sorted de Source et/ou Destination à True, tu peux faire sauter la fonction BubbleSortAscii_2.
'Exemple; Les fonctions suivent...
Private Sub Command1_Click()
Dim asTmp() As String
Dim UB As Integer
Dim iCmpt As Integer
UB = List1.ListCount - 1
ReDim asTmp(UB)
For iCmpt = 0 To UB
asTmp(iCmpt) = List1.List(iCmpt)
Next iCmpt
RetirerDoublons asTmp 'Call
'On enlève les éléments vides...
CompresserListeStr2 asTmp 'Call
'On met en ordre...
BubbleSortAscii_2 asTmp 'Call
UB = UBound(asTmp)
List2.Clear
For iCmpt = 0 To UB
List2.AddItem asTmp(iCmpt)
Next iCmpt
End Sub
'/Exemple
Public Sub RetirerDoublons(ByRef Tableau1() As String)
Dim Compte As Long ' Nombre d'item dans la liste
Dim Cmpt1 As Long ' Boucle
Dim Cmpt2 As Long ' Boucle 2
Compte = UBound(Tableau1)
For Cmpt2 = 0 To (Compte - 1)
If (LenB(Tableau1(Cmpt2)) > 0) Then 'Si cet item n'as pas déjà été compilé...
' 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
'Else
End If
Next Cmpt2
End Sub
Public Sub BubbleSortAscii_2(ByRef SortArray() As String, Optional ByVal Sens As Variant)
'Classe le contenu du tableau "SortArray" selon "Sens"
'[Optionnel] "Sens", si non indiqué (donc 0), classe en ordre ascendant
'Limité aux String
'Retourne rien pour l'instant.
'
'
'Utile dans un module:
' Global Const cstAscendant = 0
' Global Const cstDescendant = 1
'
Dim Cmpt As Integer 'Compteur
Dim Cmpt2 As Integer 'Compteur
Dim Tmp As String 'Variable d'échange
Dim TmpInt1 As Integer
Dim TblLwrBnd As Integer 'Borne Minimale, habituellement 0 ou 1
Dim TblUprBnd As Integer 'Borne Maximale, habituellement au moins 1 de plus que TblLwrBnd
Dim LclSens As Integer
'Le Sens de classement est énoncé et valide?
If (IsMissing(Sens) Or (VarType(Sens) <> vbInteger)) Then
LclSens = 0 'Si pas énoncé défaut à 0
Else
If (Sens > 1) Then
LclSens = 0
Else
LclSens = Sens
End If
End If
'Lecture des limites du tableau...
TblLwrBnd = LBound(SortArray)
TblUprBnd = UBound(SortArray)
'Classement...
For Cmpt = TblLwrBnd To (TblUprBnd - 1) 'En théorie si on dit 6, donc Index vas de 0 à 5
For Cmpt2 = (Cmpt + 1) To TblUprBnd
TmpInt1 = StrComp(UCase$(SortArray(Cmpt)), UCase$(SortArray(Cmpt2))) If (((TmpInt1 > 0) And LclSens 0) Or ((TmpInt1 < 0) And LclSens 1)) Then
Tmp = SortArray(Cmpt2)
SortArray(Cmpt2) = SortArray(Cmpt)
SortArray(Cmpt) = Tmp
End If
Next Cmpt2
Next Cmpt
End Sub
Public Sub CompresserListeStr2(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
Dim Finis As Boolean
Nombre = UBound(InListe)
Cmpt = LBound(InListe)
'Compresser la liste en déplacant les items vers le haut...
Do While ((Cmpt < Nombre) And (Not Finis))
If (LenB(InListe(Cmpt)) > 0) Then
Cmpt = Cmpt + 1
'Cmpt2 = Cmpt
Else
Cmpt2 = Cmpt
Do While ((LenB(InListe(Cmpt2)) = 0) And (Cmpt2 < Nombre))
Cmpt2 = Cmpt2 + 1
Loop
If (LenB(InListe(Cmpt2)) > 0) Then
InListe(Cmpt) = InListe(Cmpt2)
InListe(Cmpt2) = vbNullString
'Cmpt2 = Cmpt
Else
'Cmpt2 = Cmpt
'Cmpt = Nombre
Finis = True
End If
End If
Loop
If (Cmpt > 0) Then Cmpt = Cmpt - 1
ReDim Preserve InListe(Cmpt)
Exit Sub
End Sub