Classement de 2 chaines par ordre lexicographique (alphabetique)

Soyez le premier à donner votre avis sur cette source.

Vue 6 266 fois - Téléchargée 200 fois

Description

Comme le titre le dit le programme classe deux chaines par ordre alphabetique.

Source / Exemple :


'Dans la source du Zip il y a des commentaires

Function Class(Str1 As String, Str2 As String) As Integer
Dim i As Integer                      
Dim Temp1 As String                   
Dim Temp2 As String                     
Dim Lenght As Integer                  
Dim State As Integer                  
                                       
Const EqualStrings = 1                    
Const String2IsFirst = 2                 
Const String1IsFirst = 3                  

On Error Resume Next                    

Str1 = Trim(Str1)                       
Str2 = Trim(Str2)                       

If Len(Str2) < Len(Str1) Then           
    Lenght = Len(Str2)                  
Else                                    
    Lenght = Len(Str1)
End If

For i = 1 To Lenght                    
    Temp1 = Mid(Str1, i, 1)             
    Temp2 = Mid(Str2, i, 1)             
    
    If Asc(Temp1) = Asc(Temp2) Then     
        State = EqualStrings            
            If Len(Str1) > Len(Str2) Then       
                State = String2IsFirst          
            ElseIf Len(strstr1) < Len(Str2) Then    
                State = String1IsFirst              
            End If                              
    ElseIf Asc(Temp1) > Asc(Temp2) Then 
        State = String2IsFirst          
        Exit For                        
    ElseIf Asc(Temp1) < Asc(Temp2) Then 
        State = String1IsFirst          
        Exit For                        
    End If                              
Next i                                  

Class = State                           

End Function

Private Sub Command1_Click()
Dim Result  As Integer
Const EqualStrings = 1         
Const String2IsFirst = 2
Const String1IsFirst = 3

Result = Class(Text1.Text, Text2.Text)    
Label2.Caption = ""                
Label3.Caption = ""                 

If Result = String1IsFirst Then         
    Label2.Caption = "1 - " & Text1.Text    
    Label3.Caption = "2 - " & Text2.Text    
ElseIf Result = String2IsFirst Then        
    Label2.Caption = "1 - " & Text2.Text
    Label3.Caption = "2 - " & Text1.Text
ElseIf Result = EqualStrings Then        
    Label1.Caption = "Les deux chaines sont identiques"
    Label2.Caption = ""
End If

End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
309
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
15 juin 2015
1
Renfield> super pour tes codes ! merci !

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
Messages postés
50
Date d'inscription
mardi 13 mai 2003
Statut
Membre
Dernière intervention
4 novembre 2008

À GeneticWolf : Fait le test avec ce code et dit moi si depuis VB 3.0
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.
Messages postés
3
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
29 mai 2003

très joli, mais très peu productif. Depuis VB 3.0, on peut directement faire:

if chaine1$ < Chaine2$ then
msgbox "La chaine 1 vient avant"
else
...
Messages postés
50
Date d'inscription
mardi 13 mai 2003
Statut
Membre
Dernière intervention
4 novembre 2008

Salut,
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
Messages postés
15
Date d'inscription
mardi 11 juin 2002
Statut
Membre
Dernière intervention
15 juillet 2004

Ben moi je dits que c'est pas mal quand même !
J'adore son code car il est clair. Constantes etc... Il est facile à comprendre et c'est ce que j'aime. Contrairement à mes sources... ;-)
Afficher les 11 commentaires

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.