Discussion :

[PhantomSR]

Bonjour je suis un étudiant en génie civil et j'ai besoin de ce fonctionnement pour un autre code, j'ai un cours où il faut proposer une bonne combinaison et pour ce faire j'ai juste à les tester mais je n'arrive pas à les énumérer.

Comment obtenir toute les combinaisons possibles avec un balayage i j. Peut être que vous pouvez m'aider à comprendre ce qui cloche. (l'exemple est en pièce jointe)

j'aimerais avoir toute les autres lignes à savoir aBc abC Abc ABc aBC etc...





Merci beaucoup !

[mfoxy]

Bonjour,

J'ai eu le même souci que toi, il y a quelques temps et voici la fonction que j'avais trouvé à l'époque.
Je l'ai testé avec ta chaine de caractères et en voici le résultat :

abc
Abc
aBc
ABc
abC
AbC
aBC
ABC


Le Code :

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
Sub test()
 
Dim sChaine As String
Dim sh As Worksheet
 
Set sh = ThisWorkbook.Worksheets("Sheet1") 'Change Sheet1 by your sheet name
sChaine = "abc"                            'Change by your string ! Max 20 characters
 
    Call CharPermut("abc", sh)
 
End Sub
 
Sub CharPermut(ByVal str As String, destWS As Worksheet)
 
 
Dim uBool As Boolean
Dim numLetters As Long, i As Long, j As Long, repeatCounter As Long
 
 
Dim toRepeat As Long
 
    'Loop through characters in string and record whether they are "flippable"
    '(ie whether they are a letter from a-z)
    ReDim flippable(1 To Len(str), 1 To 2) As Variant
    str = LCase(str)
 
    For i = 1 To Len(str)
        flippable(i, 1) = Mid(str, i, 1)
        Dim aVal As Long
        aVal = Asc(flippable(i, 1))
        If aVal >= 97 And aVal <= 122 Then
            flippable(i, 2) = True
            numLetters = numLetters + 1
        Else
            flippable(i, 2) = False
        End If
    Next
 
    'Alert user if character limit has been exceeded
    If numLetters > 20 Then
        MsgBox "Error: Function only supports up to 20 ""flippable"" letters"
        Stop
        Exit Sub
    End If
 
    'Fill array of permutations
    ReDim resultsArr(1 To 2 ^ numLetters, 1 To 1) As String
 
    toRepeat = 1
    For i = 1 To Len(str)
 
        uBool = False
        repeatCounter = 0
        For j = 1 To UBound(resultsArr, 1)
            If flippable(i, 2) = True Then
 
                If repeatCounter >= toRepeat Then
                    uBool = Not uBool
                    repeatCounter = 0
                End If
 
                If uBool = False Then
                    resultsArr(j, 1) = resultsArr(j, 1) & flippable(i, 1)
                Else
                    resultsArr(j, 1) = resultsArr(j, 1) & UCase(flippable(i, 1))
                End If
 
                repeatCounter = repeatCounter + 1
            Else
                resultsArr(j, 1) = resultsArr(j, 1) & flippable(i, 1)
            End If
        Next
 
        If flippable(i, 2) = True Then
            toRepeat = toRepeat * 2
        End If
    Next
 
    destWS.Range(destWS.Cells(1, 1), destWS.Cells(UBound(resultsArr), 1)) = resultsArr 'Paste results to destination sheet
 
End Sub

[ARTURO83]

Bonjour,

Autre proposition

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Permut()
    Dim Lig As Integer, L1 As Integer, i As Integer, j As Integer
    Application.ScreenUpdating = False
    Lig = 6
    For L1 = 1 To 2
        For i = 1 To 2
            For j = 1 To 2
                Cells(Lig, "A") = Cells(1, L1) & Cells(2, i) & Cells(3, j)
                Lig = Lig + 1
            Next j
        Next i
    Next L1
End Sub

Cdlt

[PhantomSR]

Bonjour,

Autre proposition

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Permut()
    Dim Lig As Integer, L1 As Integer, i As Integer, j As Integer
    Application.ScreenUpdating = False
    Lig = 6
    For L1 = 1 To 2
        For i = 1 To 2
            For j = 1 To 2
                Cells(Lig, "A") = Cells(1, L1) & Cells(2, i) & Cells(3, j)
                Lig = Lig + 1
            Next j
        Next i
    Next L1
End Sub

Cdlt

Merci beaucoup pour ta réponse c'est exactement ce que je cherchais, je vais pouvoir l'adapter pour une autre utilisation je te souhaite une bonne soirée !