Simplification d'une partie de macro

**Icolf** · 08/05/2020, 14h15

Bonjour à tous.

En raison de la situation actuelle, et pour faire passer le temps, je me suis lancé un défi.
Faire un Scrabble sur Excel.
Prétentieux pour un amateur aguerri, mais j'aime bien me casser la tête

Cependant, après trois semaines à essayer de trouver par moi-même, je doit avouer que je bloque sur un bout de code que je voudrait mettre en place, et aimerait donc un petit coup de main.

Tout d'abord, voici ce que je voudrait faire :
- Je souhaiterais établir, à partir d'un texte qui a déjà fait l'objet d'un traitement de tri alphabétique, pouvoir lister toutes les combinaisons de mots possibles.
Pour cela, voici les données à prendre en compte :
- Le mot doit faire entre 2 et 15 lettres.
- Toutes les lettres de l'alphabet sont pris en compte (de A à Z, en majuscule bien entendu).
- Parmi les 102 jetons que l'ont peux piocher, 2 sont des jokers, pouvant prendre comme valeur n'importe quelle lettre de l'alphabet (majuscule).
-

Ainsi, avec ces données, voici un exemple qu'Excel doit me ressortir :
- Mot de base 7 lettres : "?ABCDEF" avec en gras la valeur du joker.
- Liste de mot de 2 lettres : AA, BA, etc... BA, BB, BC, etc...
- Liste de mot de 3 lettres : AAB, BAB, etc... AAC, BAC, CAC, etc...
- Liste de mot de 4 lettres : etc...
- jusqu'à 7 lettres

Jusque là j'ai pu m'en sortir.

Mais il est possible d'avoir deux joker tel que "??ABCDE".

C'est à ce niveau que je n'arrive plus à faire gérer les valeurs des jokers pour me ressortir la liste voulue.

De plus, j'aimerais savoir si il y a un moyen de simplifier le morceau de code ci-joint ?

Si quelqu'un pourrait me mettre sur la voie, je vous en serait reconnaissant.

Je ne peux mettre mon fichier actuel en pj, trop volumineux...

Dans l'attente d'un retour

Bien cordialement.

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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 
Sub Lister_les_possibilites_du_chevalet()
 
Dim L1 As Long, L2 As Long, L3 As Long, L4 As Long, L5 As Long, L6 As Long, L7 As Long
Dim Lettre_1 As String, Lettre_2 As String, Lettre_3 As String, Lettre_4 As String, Lettre_5 As String, Lettre_6 As String, Lettre_7 As String
Dim mot_mem As String
Dim i As Long
Dim col_pla_rec_mot_fin As Long
Declarer_les_donnees
 
'Stop
Worksheets(feu_pla).Select
 
Application.ScreenUpdating = False
a = 2
nb = 0
 
lig_pla_rec_mot_deb = Worksheets(feu_pla).Range("Ligne_de_recherche_zero").Row + 1
col_pla_rec_mot_deb = Worksheets(feu_pla).Range("Ligne_de_recherche_zero").Column
 
lig_pla_rec_mot_fin = Worksheets(feu_pla).Cells(1048576, col_pla_rec_mot_deb + 1).End(xlUp)(2).Row
col_pla_rec_mot_fin = col_pla_rec_mot_deb + 4
 
Worksheets(feu_pla).Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb), Cells(lig_pla_rec_mot_fin, col_pla_rec_mot_fin)).Value = ""
 
nb_lettre = Len(Worksheets(feu_pla).Range("Chevalet_test_trié").Value)
 
If nb_lettre < 2 Then
    Exit Sub
Else
 
Do While a <= nb_lettre
    For L1 = 1 To nb_lettre
    Lettre_1 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L1, 1)
        For L2 = L1 + 1 To nb_lettre
        Lettre_2 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L2, 1)
            If a >= 3 Then
            For L3 = L2 + 1 To nb_lettre
            Lettre_3 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L3, 1)
                If a >= 4 Then
                For L4 = L3 + 1 To nb_lettre
                Lettre_4 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L4, 1)
                    If a >= 5 Then
                    For L5 = L4 + 1 To nb_lettre
                    Lettre_5 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L5, 1)
                        If a >= 6 Then
                        For L6 = L5 + 1 To nb_lettre
                        Lettre_6 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L6, 1)
                            If a >= 7 Then
                            For L7 = L6 + 1 To nb_lettre
                            Lettre_7 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L7, 1)
'Stop
                    If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
 
Reprendre6:
 
 
                            Next
                            Else
 
                            If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
Reprendre5:
 
 
                            End If
                        Next
                        Else
 
                    If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
Reprendre4:
 
 
                        End If
                    Next
                    Else
 
                    If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
Reprendre3:
 
 
                    End If
                Next
                Else
 
                If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
Reprendre2:
 
                End If
            Next
            Else
 
                If Lettre_1 = "?" And a <= nb_lettre Then GoTo Symbole1 Else GoTo Normal
Reprendre1:
 
            'Mot_valide
            End If
        Next
 
    Next
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
a = a + 1
'Stop
Loop
End If
''''''''''''''''''''''''''''
 
'lig_pla_rec_mot_deb = Worksheets(feu_pla).Range("Ligne_de_recherche_zero").Row + 1
'lig_pla_rec_mot_fin = Worksheets(feu_pla).Cells(1048576, col_pla_rec_mot_deb).End(xlUp)(2).Row
 
 
'Do While lig_pla_rec_mot_deb < lig_pla_rec_mot_fin
'    mot_ecr = Worksheets(feu_pla).Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 1).Value
'    i = lig_pla_rec_mot_deb + 1
'    Do While i < lig_pla_rec_mot_fin
'        If Worksheets(feu_pla).Cells(i, col_pla_rec_mot_deb + 1).Value = mot_ecr Then
'            Worksheets(feu_pla).Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 1).Select
'            Worksheets(feu_pla).Cells(i, col_pla_rec_mot_deb + 1).Select
'            Worksheets(feu_pla).Cells(i, col_pla_rec_mot_deb + 1).Value = ""
'        Else: End If
'    i = i + 1
'    Loop
'lig_pla_rec_mot_deb = lig_pla_rec_mot_deb + 1
'Loop
 
lig_pla_rec_mot_deb = Worksheets(feu_pla).Range("Ligne_de_recherche_zero").Row + 1
lig_pla_rec_mot_fin = Worksheets(feu_pla).Cells(1048576, col_pla_rec_mot_deb).End(xlUp)(2).Row
 
'Worksheets(feu_pla).Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb), Cells(lig_pla_rec_mot_fin, col_pla_rec_mot_fin)).Select
 
    ActiveWorkbook.Worksheets("Plateau").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plateau").Sort.SortFields.Add Key:=Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 4), Cells(lig_pla_rec_mot_fin, col_pla_rec_mot_deb + 4)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Plateau").Sort.SortFields.Add Key:=Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 1), Cells(lig_pla_rec_mot_fin, col_pla_rec_mot_deb + 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
 
    With ActiveWorkbook.Worksheets("Plateau").Sort
        .SetRange Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 1), Cells(lig_pla_rec_mot_fin, col_pla_rec_mot_fin))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
   End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True
 
                Worksheets(feu_pla).Range(Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 1), Cells(lig_pla_rec_mot_deb, col_pla_rec_mot_deb + 3)).Select
 
MsgBox "Terminé"
 
Exit Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Symbole1:
For i = 1 To 26
    Lettre_1 = Chr(64 + i)
 
    mot_ecr = Tri_alphabétique_du_mot(Lettre_1 & Lettre_2 & Lettre_3 & Lettre_4 & Lettre_5 & Lettre_6 & Lettre_7)
    Mot_valide
    'MsgBox mot_ecr
Next
i = 1
Lettre_1 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L1, 1)
Lettre_2 = Mid(Worksheets(feu_pla).Range("Chevalet_test_trié").Value, L2, 1)
 
'Stop
GoTo Retour
 
Normal:
    mot_ecr = Lettre_1 & Lettre_2 & Lettre_3 & Lettre_4 & Lettre_5 & Lettre_6 & Lettre_7
    Mot_valide
GoTo Retour
 
Retour:
If Lettre_3 = "" Then
    GoTo Reprendre1
ElseIf Lettre_4 = "" Then
    GoTo Reprendre2
ElseIf Lettre_5 = "" Then
    GoTo Reprendre3
ElseIf Lettre_6 = "" Then
    GoTo Reprendre4
ElseIf Lettre_7 = "" Then
    GoTo Reprendre5
ElseIf Lettre_7 <> "" Then
    GoTo Reprendre6
Else
 
End If
 
 
End Sub

Simplification d'une partie de macro [XL-2010]

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager