جایگشت حروف

[generalsamad]

با سلام
یه فایل پیوست میکنم کسی خواست از کدش استفاده کنه
کار این فایل اینه که کل جایگشتهای چند حرف رو مینویسه
این کد تا جایگشت 9 کاراکتر رو پشتیبانی میکنه چون اگه بیشتر بشه تعداد جایگشتها خیلی زیاد میشه و ممکنه اکسل کند بشه تا عملیات جایگشت رو انجام بده
مثلا برای 9 کاراکتر 362880 جایگشت وجود داره
برای 10 کاراکتر میشه 3628800

Dim CurrentRow

Sub GetString()
    Dim InString As String
    InString = InputBox("Enter text to permute:")
    If Len(InString) < 2 Then Exit Sub
    If Len(InString) >= 10 Then
        MsgBox "Too many permutations!"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        CurrentRow = 1
        Call GetPermutation("", InString)
    End If
End Sub

Sub GetPermutation(x As String, y As String)
    Dim i As Integer, j As Integer
    j = Len(y)
    If j < 2 Then
        Cells(CurrentRow, 1) = x & y
        CurrentRow = CurrentRow + 1
    Else
        For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
        Next
    End If
End Sub 

فایل ضمیمه شد

[shabnamsohrabif]

دستتون درد نکنه عالی بود