Ordre alphabétique

Commenter

Contenu du snippet

cette fonction permet de trier un tableau de strings dans l'ordre alphabétique.

ps: on a besoin de 2 fonctions annexes

Source / Exemple : 


Function ordre_alphabetique(ByVal tableau_de_string() As String)
    Dim nb As Integer = UBound(tableau_de_string, 1)
    'en premier on enlève les blancs éventuels:
    For i = 1 To nb
      If tableau_de_string(i) = "" Then
        For u = i To nb - 1
          tableau_de_string(u) = tableau_de_string(u + 1)
        Next
        tableau_de_string(nb) = ""
      End If
    Next
    Dim sortie(nb) As String
    sortie(1) = tableau_de_string(1)
    'on prend un mot de la liste (k)
    'on le compare a ceux de la liste de sortie (i)
    'et on l'insère
    For k = 2 To nb
      If tableau_de_string(k) = "" Then
        Return sortie
        Exit Function
      Else
        For i = 1 To nb 'on compare le texte a tous les textes de sortie
          If sortie(i) = "" Then
            sortie(i) = tableau_de_string(k)
            GoTo mot_suivant
          Else
            If compare_2_strings(tableau_de_string(k), sortie(i)) = True Then
              For u = nb - 1 To i Step -1
                sortie(u + 1) = sortie(u)
              Next
              sortie(i) = tableau_de_string(k)
              'on passe au suivant:
              GoTo mot_suivant
            End If
          End If
        Next
      End If
mot_suivant:
    Next
    Return sortie
  End Function

  Function compare_2_strings(ByVal string1 As String, ByVal string2 As String)
    'renvoi true si la 1ere est bien avant la seconde
    Dim reponse As Boolean
    For i = 1 To 40
      If Strings.Mid(string1, i, 1) = "" And Strings.Mid(string2, i, 1) <> "" Then
        Return True
        Exit Function
      End If
      If Strings.Mid(string1, i, 1) <> "" And Strings.Mid(string2, i, 1) = "" Then
        Return False
        Exit Function
      End If
      If Strings.Mid(string1, i, 1) <> Strings.Mid(string2, i, 1) Then
        If position_dans_alphabet(Strings.Mid(string1, i, 1)) > position_dans_alphabet(Strings.Mid(string2, i, 1)) Then
          Return False
          Exit Function
        Else
          Return True
          Exit Function
        End If
      End If
    Next
    Return True 's'ils sont identiques
  End Function

  Function position_dans_alphabet(ByVal lettre As String)
    lettre = LCase(lettre)
    Dim nb As Integer
    Select Case lettre
      Case "a"
        nb = 1
      Case "b"
        nb = 2
      Case "c"
        nb = 3
      Case "d"
        nb = 4
      Case "e"
        nb = 5
      Case "f"
        nb = 6
      Case "g"
        nb = 7
      Case "h"
        nb = 8
      Case "i"
        nb = 9
      Case "j"
        nb = 10
      Case "k"
        nb = 11
      Case "l"
        nb = 12
      Case "m"
        nb = 13
      Case "n"
        nb = 14
      Case "o"
        nb = 15
      Case "p"
        nb = 16
      Case "q"
        nb = 17
      Case "r"
        nb = 18
      Case "s"
        nb = 19
      Case "t"
        nb = 20
      Case "u"
        nb = 21
      Case "v"
        nb = 22
      Case "w"
        nb = 23
      Case "x"
        nb = 24
      Case "y"
        nb = 25
      Case "z"
        nb = 26
      Case Else
        nb = 0
    End Select
    Return nb
  End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (michael59330)