CLASSEMENT DE 2 CHAINES PAR ORDRE LEXICOGRAPHIQUE (ALPHABETIQUE)
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
-
27 mai 2003 à 20:10
Philippe734 Messages postés 308 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 15 juin 2015 - 13 juin 2004 à 10:15
Philippe734 Messages postés 308 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 15 juin 2015 - 13 juin 2004 à 10:15
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/7248-classement-de-2-chaines-par-ordre-lexicographique-alphabetique
https://codes-sources.commentcamarche.net/source/7248-classement-de-2-chaines-par-ordre-lexicographique-alphabetique
13 juin 2004 à 10:15
son dernier code, celui pour trier des tableaux entiers de mots, prends en compte aussi les accents.
dpouliot> ton exemple, est résolu correctement avec son code.
merci, c juste ce que je cherchai
30 mai 2003 à 15:41
les accentués sont bien géré.
Dim chaine1 As String
Dim chaine2 As String
chaine1 = "Servante"
chaine2 = "École"
If chaine1 < chaine2 Then
MsgBox "La chaine 1 vient avant"
Else
MsgBox "La chaine 2 vient avant"
End If
Cette comparaison n'est pas correct.
29 mai 2003 à 21:19
if chaine1$ < Chaine2$ then
msgbox "La chaine 1 vient avant"
else
...
28 mai 2003 à 17:21
Bon prog. Mais il y a le problème des accentués et des majuscules.
Faites le test avec "Élève" et "Servante" sans parler des "ae". "oe".
La solution est de redresser tous les caractères et d'ignorer ceux qui n'en sont pas ex.: le trait d'union, l'apostrophe...
Voici le code, Nb. vérifier la correspondance des caractères en fonctions de la grille utilisée par votre ordinateur.
Dans la fonction Class, Ajouter après celles de trim
Str1 = cnv_pauvre(Str1)
Str2 = cnv_pauvre(Str2)
ET ajouter cette fonction
Function cnv_pauvre(ch_in As String) As String
Dim cc1 As Integer
Dim cc2 As Integer
Dim cc_len As Integer
Dim ch_out As String
cc_len = Len(ch_in)
While cc < cc_len
cc = cc + 1
Select Case Mid(ch_in, cc, 1)
' caractères accentués
Case "@", "À" To "Ä", "à" To "å"
ch_out = ch_out & "a"
Case "Æ", "æ" ' éclate le caractère
ch_out = ch_out & "ae"
Case "Ç", "ç"
ch_out = ch_out & "c"
Case "È" To "Ë", "è" To "ë"
ch_out = ch_out & "e"
Case "Ì" To "Ï", "ì" To "ï"
ch_out = ch_out & "i"
Case "Ð"
ch_out = ch_out & "d"
Case "Ñ", "ñ"
ch_out = ch_out & "n"
Case "Ò" To "Ö", "ò" To "ö"
ch_out = ch_out & "0"
Case "O", "o" ' éclate le caractère
ch_out = ch_out & "0e"
Case "Ù" To "Ü", "ù" To "ü"
ch_out = ch_out & "u"
Case "Ý", "ý", "ÿ"
ch_out = ch_out & "y"
Case "A" To "Z" ' les majuscules en minuscule
ch_out = ch_out & Chr(Asc(Mid(ch_in, cc, 1)) + 32)
Case "0" To "9", "a" To "z" ' conserve les caractères de base
ch_out = ch_out & Mid(ch_in, cc, 1)
Case Else ' ICI tous les autres caractères seront ignérés, même les espaces
' ne fait rien
End Select
Wend
cnv_pauvre = ch_out
End Function
À la prochaine
28 mai 2003 à 09:50
J'adore son code car il est clair. Constantes etc... Il est facile à comprendre et c'est ce que j'aime. Contrairement à mes sources... ;-)
28 mai 2003 à 09:03
Merci à tous les deux. Tous les trucs d'optiomisations devraient faire l'objet d'un source à part.
Per exemple, je savais qu'il fallait tjrs mieux faire un Len(sMaChaine)>0 que sMachaine<>""
27 mai 2003 à 22:57
Merci quand même.
27 mai 2003 à 21:49
Private Enum ClassResult
CR_EqualStrings = 1
CR_String2IsFirst = 2
CR_String1IsFirst = 3
End Enum
Private Function Class(Str1 As String, Str2 As String) As ClassResult
Select Case StrComp(Str1, Str2, vbTextCompare)
Case 0: Class = CR_EqualStrings
Case -1: Class = CR_String1IsFirst
Case 1: Class = CR_String2IsFirst
End Select
End Function
Sub Class_List(Output() As String, ParamArray Mots() As Variant)
Dim a As Integer
Dim tmp As String
Dim AppliedModifications As Boolean
ReDim Output(UBound(Mots))
For a = LBound(Output) To UBound(Output)
Output(a) = Mots(a)
Next a
AppliedModifications = True
While AppliedModifications 'méthode dite du "Tri à bulles"
AppliedModifications = False
For a = LBound(Output) To UBound(Output) - 1
If Class(Output(a), Output(a + 1)) = CR_String2IsFirst Then
AppliedModifications = True
tmp = Output(a)
Output(a) = Output(a + 1)
Output(a + 1) = tmp
End If
Next a
Wend
End Sub
Private Sub Form_Load()
Dim Output() As String
Dim a As Integer
Call Class_List(Output, "aaa", "zzz", "rrr", "ggg")
For a = LBound(Output) To UBound(Output)
Debug.Print Output(a)
Next a
End Sub
27 mai 2003 à 21:33
c'est bon a savoir, si vous utilisez beaucoup de comparaison de chaînes, et que vous souhaitez optimiser vos algo...
27 mai 2003 à 21:31
Const EqualStrings = 1
Const String2IsFirst = 2
Const String1IsFirst = 3
Function Class(Str1 As String, Str2 As String) As Integer
select case strcomp ( Str1 , Str2 , vbTextCompare )
case 0: Class = EqualStrings
case -1: Class = String1IsFirst
case 1: Class = String2IsFirst
end select
end function
27 mai 2003 à 20:10
"programmons" > "programmez"
ce qui donnerais :
Function Class(Str1 As String, Str2 As String) As Integer
Class = iif ( Str1 > Str2 , 2, 1)
end function