XL 2013 VBA : comparaison de texte avec nombres immiscés à l'intérieur (TextAsNumber)

[dionys0s]

Bonjour le forum

je cherche à améliorer mon algorithme de tri rapide d'un tableau à une dimension, de telle sorte qu'il puisse trier correctement les chaînes de caractère qui contiennent des nombres. Pour le moment, le tableau {"10 blabla", "2 blabla", "1 blabla", "20 blabla"} après trié comme ceci {"1 blabla", "10 blabla", "2 blabla", "20 blabla"}, et j'aimerais qu'il soit trié comme ceci : {"1 blabla", "2 blabla", "10 blabla", "20 blabla"}.

C'est quelque chose qu'Excel fait tout seul quand on utilise la fonction sort (XlSortDataOption = xlSortTextAsNumbers), mais j'aimerais me passer d'écrire le contenu de ma variable tableau dans un onglet temporaire, et donc uniquement me baser sur la comparaison de texte.

D'avance merci pour votre aide !

Public Sub SortArr(ByRef Arr() As Variant, ByVal Ord As Excel.XlSortOrder, ByVal LBnd As Long, ByVal UBnd As Long)

  Dim Memo As Variant, x As Long, Idx As Long
  Dim NewIdx As Long, Modif As Boolean

  Do: x = 1 + 3 * x: Loop Until x > (UBnd - LBnd + 1)
  If Ord = Excel.xlAscending Then
    Do: x = x / 3: For Idx = x + LBnd To UBnd
      Memo = Arr(Idx): NewIdx = Idx
      Do While Arr(NewIdx - x) > Memo: Modif = True
        Arr(NewIdx) = Arr(NewIdx - x)
        NewIdx = NewIdx - x: If NewIdx < x + LBnd Then Exit Do
      Loop: If Modif Then Arr(NewIdx) = Memo
    Modif = False: Next Idx: Loop Until x = 1

  ElseIf Ord = Excel.xlDescending Then
    Do: x = x / 3: For Idx = x + LBnd To UBnd
      Memo = Arr(Idx): NewIdx = Idx
      Do While Arr(NewIdx - x) < Memo: Modif = True
        Arr(NewIdx) = Arr(NewIdx - x)
        NewIdx = NewIdx - x: If NewIdx < x + LBnd Then Exit Do
      Loop: If Modif Then Arr(NewIdx) = Memo
    Modif = False: Next Idx: Loop Until x = 1
  End If

End Sub

 

[Robert]

Bonjour dionys0s, bonjour le forum,

Une autre méthode :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TF() As Variant 'déclare la variable TF (Tableau Final)
Dim T1 As Integer 'déclare la variable T1 (Temporaire 1)
Dim T2 As String 'déclare la variable T2 (Temporaire 2)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
ReDim TL(1 To 2, 1 To UBound(TV, 1)) 'redimensionne les tableau des lignes TL
For I = 1 To UBound(TV) 'boucle sur toutes les lignes I du tableau des valeurs TV
    TL(1, I) = CInt(Split(TV(I, 1), " ")(0)) 'définit la ligne 1 du tableau des lignes TL (la valeur du nombre)
    TL(2, I) = TV(I, 1) 'définit la ligne 2 du tableau des lignes TL (la valeur entière)
Next I 'prochaine ligne de la boucle
For I = 1 To UBound(TL, 2) 'boucle 1 : sur toutes les lignes I du tableau des lignes TL
    For J = 1 To UBound(TL, 2) 'boucle 2 : sur toutes les lignes J du tableau des lignes TL
        'si I est différent de J et la valeur TL(1,I) est inférieure à TL(1,J), inverse les données
        If I <> J And TL(1, I) < TL(1, J) Then T1 = TL(1, I): T2 = TL(2, I): TL(1, I) = TL(1, J): TL(2, I) = TL(2, J): TL(1, J) = T1: TL(2, J) = T2
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
TV = Application.Index(TL, 2) 'récupère dans le tableau TV la deuxième ligne du tableau TL
O.Range("E1").Resize(UBound(TV, 1), 1) = Application.Transpose(TV) 'renvoie le, tableau TV transposé dans E1 redimensionnée
End Sub

 

[patricktoulon]

bonjour

Sub test()
    Dim Tbl, ordre
    Tbl = Array("10 blabla", "2 blabla", "1 blabla", "20 blabla", "275 blabla", "128 balabla")
    ordre = InOrder(Tbl)
MsgBox Join(ordre, ",")
End Sub

Function InOrder(Tbl)
    Dim tblordre(), i&, x
    ReDim tblordre(1 To 1)
    For i = 0 To UBound(Tbl)
        x = Val(Tbl(i))
        If x > UBound(tblordre) Then ReDim Preserve tblordre(1 To x)
        tblordre(x) = Tbl(i)
    Next
x = Join(tblordre, ",")
Do While x Like "*,,*": x = Replace(x, ",,", ","): Loop
InOrder = Split(x, ",")
End Function

 

[dionys0s]

Bonjour Robert,
re tout le monde,

merci pour ta proposition. Je vais m'en inspirer, mais si je ne dis pas de bêtise, tu utilises un tri bulle, ce qui ne fera pas l'affaire compte-tenu de la volumétrie que je manipule. Toutefois, je pense que je vais m'inspirer de ta proposition (logique du split sur l'espace) pour transformer un tableau à une dimension en tableau à 2 dimensions et trier tout ça colonne par colonne avec un tri rapide.

 

[dionys0s]

Bonjour patricktoulon,
merci pour ta proposition. Je ne comprends rien pour le moment donc je vais prendre le temps d'exécuter ça pas à pas pour bien piger.

 

[Robert]

Bonjour le fil, bonjour le forum,

Ce que je voulais faire Dionys0s mais je n'y suis pas arrivé. Pense à mettre ton résultat ça m'intéresse...

 

[dionys0s]

Robert, compte sur moi ^^

 

[eriiic]

Bonjour,

possible que la méthode .Sort d'une collection soit très bien optimisée pour les grandes listes. A tester :

    Dim tabl, i As Long, co As Object
    tabl = Array("10 blabla", "2 blabla", "1 blabla", "20 blabla")
    Set co = CreateObject("System.Collections.ArrayList")
    For i = 0 To UBound(tabl)
        co.Add tabl(i)
    Next i
    co.Sort

tu diras
Je ne comprend pas trop ta réticence à utiliser une feuille. C'est un outil comme un autre, et si c'est plus rapide en plus d'être plus simple pourquoi s'en passer ?
eric