Ahoj Angelito,
Omlouváme se za pozdní odpověď.
Vyzkoušejte prosím kód níže: (Všimněte si, že kód nezpracovává řetězec delší než 8 znaků. Pokud chcete číslo zvětšit, můžete změnit číslo 8 v „If Len(xStr) >= 8 Then“ v kód na větší čísla. Čím větší je však číslo, tím pomalejší bude program.)
Sub GetString()
'Updateby Extendoffice
Dim xStr As String
Dim FRow As Long
Dim xScreen As Boolean
Dim Rg, xRg As Range
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xRg = Application.InputBox("Enter text to permute:", "Kutools for Excel", , , , , , 8)
xStr = ""
For Each Rg In xRg
xStr = xStr + Rg.Text
Next
If Len(xStr) < 2 Then Exit Sub
If Len(xStr) >= 8 Then
MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
Exit Sub
Else
ActiveSheet.Columns(1).Clear
FRow = 1
Call GetPermutation("", xStr, FRow)
End If
Application.ScreenUpdating = xScreen
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long)
Dim i As Integer, xLen As Integer
xLen = Len(Str2)
If xLen < 2 Then
Range("A" & xRow) = Str1 & Str2
xRow = xRow + 1
Else
For i = 1 To xLen
Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)
Next
End If
End Sub
Doufám, že to funguje pro vás.
Amanda