Discussion :

[galopin01]

Bonjour,
ça fait un moment que je m'emmêle les neurones sur cette question pourtant simple :
Je cherche à faire une fonction qui remet dans l'ordre alphabétique les lettres d'un mot.
Les mots sont des mots de 7 lettres ou moins (parfois 1 seul !)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim Var$
var = "galopin"
MsgBox BubbleTri(var) 'Attendu "agilnop"
End Sub
 
Function BubbleTri(mot$)
Dim Tmp$
...la suite d'instruction qui va bien ???
BubbleTri= Tmp 'renvoie "agilnop"
End Function
 
Merci

Merci.

[Invité]

regardes ça!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Test()
Dim t As String
For I = 25 To 0 Step -1
    t = t & Chr(65 + I)
Next
MsgBox t
MsgBox TrieTxt(t)
End Sub
 
Function TrieTxt(ByVal t) As String
Dim C As String
Dim I As Long
For I = 2 To Len(t)
    If Mid(t, I - 1, 1) > Mid(t, I, 1) Then
        C = Mid(t, I, 1)
        Mid(t, I, 1) = Mid(t, I - 1, 1)
        Mid(t, I - 1, 1) = C
        I = I - 2
        If I < 1 Then I = 1
    End If
 
Next
TrieTxt = t
End Function

[Kimy_Ire]

Bonjour galopin01, rdurupt,

Moi - comme d'habitude - je me suis amusé à faire un truc complexe mais fonctionnel... Alors l'optimisation n'est pas du tout au RDV mais au moins ça marche !

Si ca peut aider...
Je parcours toutes les cellules de la colonne A et je les mets en ordre alphabétique dans la colonne B.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Sub alphabet()
Dim cell_move As Range
Dim nb_car As Integer
Dim mot As String
Dim table_mot() As String
 
With Worksheets("Feuil5")
    Set cell_move = .Range("A1")
    For I = 0 To .Columns(1).Find("*", , , , , xlPrevious).Row - 1
        nb_car = Len(cell_move.Offset(I, 0))
        mot = cell_move.Offset(I, 0)
        ReDim table_mot(1 To nb_car, 1 To 2)
 
        For j = 1 To nb_car
            table_mot(j, 1) = Left(mot, 1)
            If Len(mot) > 1 Then
                mot = Right(mot, Len(mot) - 1)
            End If
            table_mot(j, 2) = position_dans_alphabet(table_mot(j, 1))
        Next j
 
        mot = ""
        For j = 0 To 26
            For k = 1 To nb_car
                If table_mot(k, 2) = j Then
                    mot = mot & table_mot(k, 1)
                End If
            Next k
        Next j
 
        cell_move.Offset(I, 1) = mot
 
    Next I
 
End With
 
End Sub
 
Function position_dans_alphabet(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
 
    position_dans_alphabet = nb
End Function

Cordialement,
Kimy

[galopin01]

Bonjour,
[rdurupt]
Merci de t'être penché sur la question.
Ton code est convaincant mais... je n'arrive pas à l'adapter à mon contexte !
Mon adaptation renvoie quelques erreurs : Curieusement ça me met le désordre si le mot initial est dans l'ordre !
Ce n'est pas grave, entre temps j'ai réussi à trouver une solution.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub BubbleTri(TT)
Dim I%, j%, k%, tmp
For k = 1 To 6
   For I = 1 To Len(TT) - 1
   j = I + 1
      If Asc(Mid(TT, j, 1)) < Asc(Mid(TT, I, 1)) Then
         tmp = Mid(TT, I, 1)
         Mid(TT, I, 1) = Mid(TT, j, 1)
         Mid(TT, j, 1) = tmp
      End If
   Next I
Next x
End Sub

Je coche donc résolu.
Bonne journée.

[Kimy_Ire] Bonjour, pas rafraichi à temps... Merci quand même !

A+