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
| Public Sub CreationChemin()
Dim intI1 As Integer, intI2 As Integer, intI3 As Integer
Dim intI4 As Integer, intI5 As Integer, intI6 As Integer, intN As Integer
Dim strTab As String
Dim sngChrono As Single
strTab = UCase(InputBox("Saisissez les éléments : ", "Saisie", "ABCDEF"))
sngChrono = Timer
intI1 = 1
Do Until Cells(1, intI1).Value = ""
intI1 = intI1 + 1
Loop
Cells(1, intI1).Select
intN = Len(strTab)
ActiveCell.Value = strTab
ActiveCell.Offset(1, 0).FormulaR1C1 = "=counta(R4C:R65536C)"
ActiveCell.Offset(3, 0).Select
For intI1 = 1 To intN
For intI2 = 1 To intN
If intI2 <> intI1 Then
For intI3 = 1 To intN
If intI3 <> intI1 And intI3 <> intI2 Then
If Len(strTab) = 3 Then
ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1)
ActiveCell.Offset(1, 0).Select
Else
For intI4 = 1 To intN
If intI4 <> intI1 And intI4 <> intI2 And intI4 <> intI3 Then
If Len(strTab) > 4 Then
For intI5 = 1 To intN
If intI5 <> intI1 And intI5 <> intI2 And intI5 <> intI3 And intI5 <> intI4 Then
If Len(strTab) > 5 Then
For intI6 = 1 To intN
If intI6 <> intI1 And intI6 <> intI2 And intI6 <> intI3 And intI6 <> intI4 And intI6 <> intI5 Then
ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1) & Mid(strTab, intI6, 1)
ActiveCell.Offset(1, 0).Select
End If
Next
Else
ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1)
ActiveCell.Offset(1, 0).Select
End If
End If
Next
Else
ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) & Mid(strTab, intI4, 1)
ActiveCell.Offset(1, 0).Select
End If
End If
Next
End If
End If
Next
End If
Next
Next
Cells(3, ActiveCell.Column).Value = (Timer - sngChrono)
End Sub |
Partager