السلام عليكم
حسنا جرب المرفق
الكود منقول بالكامل و لم اعدل فيه اي حرف .لكن لا اعرف صاحبه الاصلي .
النتيجة تعتمد علي عدد حروف الكلمة طبقا للتباديل في الرياضيات
ان كانت الكلمة3 حروف ستكون النتيجة 6 كلمات وان كانت 7 حروف ستكون النتيجة 5040 كلمة .
Dim CurrentRow As Long
Sub GetString()
Dim lngMax As Long
Dim InString As String
If Val(Application.Version) > 11 Then
lngMax = 9
Else
lngMax = 8
End If
InString = Cells(1, 1)
If Len(InString) < 2 Then Exit Sub
If Len(InString) > lngMax Then
MsgBox "Too many permutations!", vbExclamation
Exit Sub
Else
Range(Cells(2, 1), Cells(Rows.Count, 1)).ClearContents
CurrentRow = 1
Call GetPermutation("", InString)
End If
End Sub
Sub GetPermutation(x As String, y As String)
' The source of this algorithm is unknown
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
تحياتي
code+.rar