DominoArea.org [Archive]

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

salut

oui c'est possible, regarde si c'est pas là => http://forum.dominoarea.org/fonctions-de-tris-f55.html

j'avais déjà regarder les fonction de trie, elle s'applique toutes aux tableaux

c'est pas très grave mais ça fait une lourdeur de passer par un tableau temporaire juste pour le trie

et google n'a pas trouvé non plus ...

j'ai ça en stock !

Code : Tout sélectionner

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 Sub

Code : Tout sélectionner

Public 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 Sub

l'idée est toujours la même, mettre dans un tableau pour trier, j'avais espérer un truc non documenté qui permet de trier une liste

j'ai fait ça

Code : Tout sélectionner

ForAll 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


j'ai utilisé mon tableau après
merci quand même