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 |
Partager