generalsamad
2015/04/06, 23:05
با سلام
یه فایل پیوست میکنم کسی خواست از کدش استفاده کنه
کار این فایل اینه که کل جایگشتهای چند حرف رو مینویسه
این کد تا جایگشت 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
فایل ضمیمه شد
یه فایل پیوست میکنم کسی خواست از کدش استفاده کنه
کار این فایل اینه که کل جایگشتهای چند حرف رو مینویسه
این کد تا جایگشت 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
فایل ضمیمه شد