Bonjour c'est juste une question au cas ou
il est possible de trier une liste ?
pour le moment je passe la liste dans un tableau pour trier, mais ça serait plus élégant de trier directement sur la clef de la liste
Public Sub SortingList(wvrList As Variant, wnbTriCroissant As Boolean)
Dim nbUbound As Long
Dim nbLbound As Long
Dim vrValue As Variant
Dim tbValue() As Variant
Dim i As Long
On Error Goto CatchError
Select Case Datatype(wvrList)
Case 0,1,9,10
rem EMPTY,NULL,OLE object or NOTHING
rem error 9999,"wvrList is Nothing"
Exit Sub
Case Else
If Islist(wvrList)= False Then
Error 9999,"wvrList is not a List"
Exit Sub
End If
End Select
nbUBound = 0
Forall Value In wvrList
nbUBound = nbUBound+1
End Forall
nbLBound = 1
If nbUBound = nbLbound Then
rem si 1 seul donné pas de traitement
Exit Sub
Elseif nbUBound = (nbLbound+1) Then
rem si uniquement 2 données
If wnbTriCroissant = True Then
rem "CROISSANT","C","A","ASCENDANT","ASCENDING","I","INCREASING","",">"
If wvrList(nbUbound) <wvrList> wvrList(nbLBound) Then
vrValue = wvrList(nbUBound)
wvrList(nbUBound) = wvrList(nbLbound)
wvrList(nbLbound) = vrValue
vrValue = Null
End If
End If
Exit Sub
End If
Redim tbValue(nbLBound To nbUBound )
i = nbLBound
Forall valueList In wvrList
tbValue(i) = valueList
i = i+1
End Forall
i=0
Erase wvrList
Call SortShell(tbValue)
If wnbTriCroissant = True Then
rem "CROISSANT","C","A","ASCENDANT","",">"
For i = nbLBound To nbUBound
wvrList(i) = tbValue(i)
Next
else
REM "DECROISSANT","D","DESCENDANT","<"
For i = nbUBound To nbLBound Step -1
wvrList(i) = tbValue(i)
Next
End If
Erase tbValue
Exit Sub
CatchError:
Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End SubPublic Sub SortingListTag(wvrList As Variant,wnbTriCroissant As Boolean)
rem trie une variable List par odre de ses tags
Dim nbUBound As Long
Dim nbLbound As Long
Dim i As Long
Dim J As Long
Dim vrValue As Variant
Dim tbTag() As Variant
Dim lstSave List As Variant
On Error Goto CatchError
Select Case Datatype(wvrList)
Case 0,1,9,10
rem EMPTY,NULL,OLE object or NOTHING
rem error 9999,"wvrList is Nothing"
Exit Sub
Case Else
If Islist(wvrList)= False Then
Error 9999,"wvrList is not a List"
Exit Sub
End If
End Select
nbUBound = 0
Forall Value In wvrList
nbUBound = nbUBound+1
End Forall
nbLBound = 1
If nbUBound = nbLbound Then
rem si 1 seul donné pas de traitement
Exit Sub
End If
Redim tbTag(nbLBound To nbUBound)
i = nbLbound
Forall value In wvrList
tbTag(i) = Listtag(value)
lstSave(tbTag(i)) = value
i=i+1
End Forall
Erase wvrList
Call SortShell(tbTag)
If wnbTriCroissant = True Then
REM "CROISSANT","C","A","ASCENDANT","ASCENDING","I","INCREASING","",">"
For i = nbLBound To nbUBound
wvrList(tbTag(i)) = lstSave(tbTag(i))
Next
Else
REM "DECROISSANT","D","DESCENDANT","DESCENDING","DECREASING","<"
For i = nbUBound To nbLBound Step -1
wvrList(tbTag(i)) = lstSave(tbTag(i))
Next
End If
Erase tbTag
Erase lstSave
Exit Sub
CatchError:
Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End SubForAll dclElem In DCList
ReDim Preserve ADC (nbDC) As String
ADC (nbDC) = ListTag (dclElem)+"¤"+dclElem
nbDC = nbDC + 1
End ForAll
' trier le tableau
Call BubbleSort (ADC) ' fonction écrite ailleurs