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
| Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
txt_File_Location = fso.GetParentFolderName(wscript.ScriptFullName) + "\Permutations avec répétition.txt" 'Emplacement du fichier .txt de sauvegarde des résultat
If fso.FileExists(txt_File_Location) Then fso.DeleteFile txt_File_Location 'S'il existe déjà, le supprimer pour vider la liste de résultat
Set txt_File = fso.OpenTextFile(txt_file_location, ForWriting, true)
Longueur = InputBox("Entrez la longueur du résultat" + vbNewLine + vbNewLine + "Pour des raisons de code et de temps de calcul, vous êtes limité à 20 caratères" + vbNewLine + vbNewLine + vbNewLine + "Les caractères en trop seront tout simplement ignorés des opérations", "Entrée de la longueur du résultat", "3")
'Longueur = "3" 'Si cette ligne est activée, neutralisez la précédente
If Longueur = "" OR Longueur = "0" Then Erreur = WshShell.Popup("Veuillez entrer une valeur au dessus de 0", 5, "ERROR", 0 + 64) : WScript.Quit 'Si la variable n'a pas de valeur, quitter
Elements = Trim(InputBox("Entrez vos éléments, séparés par des virgules" + vbNewLine + vbNewLine + "Pour des raisons de temps de calcul, il est conseillé de se limiter à 10 éléments" + vbNewLine + vbNewLine + vbNewLine + "Un nombre trop important d'éléments augmentera considérablement le temps d'attente", "Entrée des éléments", "A, B, C"))
'Elements = "A, B, C" 'Si cette ligne est activée, neutralisez la précédente
If Elements = "" Then Erreur = WshShell.Popup("Veuillez entrer une liste d'éléments" + vbNewLine + "comportant entre 1 et 10 caractères", 5, "ERROR", 0 + 64) : WScript.Quit 'Si la variable n'a pas de valeur, quitter
Elements = Replace(Elements, " ", "")
Cut = Split(Elements, ",")
If Len(Elements) = 1 Then txt_File.WriteLine Cut(0) : WScript.Quit 'S'il n'y a qu'un élément, l'écrire et quitter
For i = 1 to (UBound(Cut) + 1) ^ Longueur
Chaine = Cut(Number_Left_1) + Cut(Number_Left_2) + Cut(Number_Left_3) + Cut(Number_Left_4) + Cut(Number_Left_5) + Cut(Number_Left_6) + Cut(Number_Left_7) + Cut(Number_Left_8) + Cut (Number_Left_9) + Cut (Number_Left_10) + Cut(Number_Left_11) + Cut(Number_Left_12) + Cut(Number_Left_13) + Cut(Number_Left_14) + Cut(Number_Left_15) + Cut(Number_Left_16) + Cut(Number_Left_17) + Cut(Number_Left_18) + Cut(Number_Left_19) + Cut(Number_Left_20)
Chaine = Left(Chaine, Longueur)
txt_File.WriteLine Chaine 'Ecrire le résultat
If Left(Chaine, 1) = Cut(UBound(Cut)) Then
Number_Left_1 = 0
If Mid(Chaine, 2, 1) = Cut(UBound(Cut)) Then
Number_Left_2 = 0
If Mid(Chaine, 3, 1) = Cut(UBound(Cut)) Then
Number_Left_3 = 0
If Mid(Chaine, 4, 1) = Cut(UBound(Cut)) Then
Number_Left_4 = 0
If Mid(Chaine, 5, 1) = Cut(UBound(Cut)) Then
Number_Left_5 = 0
If Mid(Chaine, 6, 1) = Cut(UBound(Cut)) Then
Number_Left_6 = 0
If Mid(Chaine, 7, 1) = Cut(UBound(Cut)) Then
Number_Left_7 = 0
If Mid(Chaine, 8, 1) = Cut(UBound(Cut)) Then
Number_Left_8 = 0
If Mid(Chaine, 9, 1) = Cut(UBound(Cut)) Then
Number_Left_9 = 0
If Mid(Chaine, 10, 1) = Cut(UBound(Cut)) Then
Number_Left_10 = 0
If Mid(Chaine, 11, 1) = Cut(UBound(Cut)) Then
Number_Left_11 = 0
If Mid(Chaine, 12, 1) = Cut(UBound(Cut)) Then
Number_Left_12 = 0
If Mid(Chaine, 13, 1) = Cut(UBound(Cut)) Then
Number_Left_13 = 0
If Mid(Chaine, 14, 1) = Cut(UBound(Cut)) Then
Number_Left_14 = 0
If Mid(Chaine, 15, 1) = Cut(UBound(Cut)) Then
Number_Left_15 = 0
If Mid(Chaine, 16, 1) = Cut(UBound(Cut)) Then
Number_Left_16 = 0
If Mid(Chaine, 17, 1) = Cut(UBound(Cut)) Then
Number_Left_17 = 0
If Mid(Chaine, 18, 1) = Cut(UBound(Cut)) Then
Number_Left_18 = 0
If Mid(Chaine, 19, 1) = Cut(UBound(Cut)) Then
Number_Left_19 = 0
If Mid(Chaine, 20, 1) = Cut(UBound(Cut)) Then
Number_Left_20 = 0
Else
Number_Left_20 = Number_Left_20 + 1
End If
Else
Number_Left_19 = Number_Left_19 + 1
End If
Else
Number_Left_18 = Number_Left_18 + 1
End If
Else
Number_Left_17 = Number_Left_17 + 1
End If
Else
Number_Left_16 = Number_Left_16 + 1
End If
Else
Number_Left_15 = Number_Left_15 + 1
End If
Else
Number_Left_14 = Number_Left_14 + 1
End If
Else
Number_Left_13 = Number_Left_13 + 1
End If
Else
Number_Left_12 = Number_Left_12 + 1
End If
Else
Number_Left_11 = Number_Left_11 + 1
End If
Else
Number_Left_10 = Number_Left_10 + 1
End If
Else
Number_Left_9 = Number_Left_9 + 1
End If
Else
Number_Left_8 = Number_Left_8 + 1
End If
Else
Number_Left_7 = Number_Left_7 + 1
End If
Else
Number_Left_6 = Number_Left_6 + 1
End If
Else
Number_Left_5 = Number_Left_5 + 1
End If
Else
Number_Left_4 = Number_Left_4 + 1
End If
Else
Number_Left_3 = Number_Left_3 + 1
End If
Else
Number_Left_2 = Number_Left_2 + 1
End If
Else
Number_Left_1 = Number_Left_1 + 1
End If
Next
Fin = WshShell.Popup("Fin des opérations", 5, "Traitement", 0 + 64) |
Créer un VB Script capable de trouver toutes les permutations avec répétition d'une chaîne String
)
Répondre avec citation
Balises[CODE]...[/CODE]
en fin de discussion, quand vous avez obtenu l'aide attendue.
......... et pourquoi pas, pour remercier, un 
pour celui/ceux qui vous ont dépannés.
Envoyé par hackoofr
):
Ce qui me pose problème, c'est le repérage du caractère à modifier... (à la fin du code...)
Partager