tbell000
asked on
stopping a number from permutating twice
When I enter a number to be permutated, the program permutates the entered number twice I.E
If I enter the number 898 the program returns 898, 988, 889, 898, 988, 889
The program works fine when i enter a number like 123 or 1234.
will not work for a number like 1122, 1223 these type of numbers get permutated twice
Here is a copy of the program
Dim CurrentRow
Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
Range("a:a").ClearContents
If Len(InString) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "Too many permutations!"
Exit Sub
Else
ActiveSheet.Columns(1).Cle
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
If I enter the number 898 the program returns 898, 988, 889, 898, 988, 889
The program works fine when i enter a number like 123 or 1234.
will not work for a number like 1122, 1223 these type of numbers get permutated twice
Here is a copy of the program
Dim CurrentRow
Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
Range("a:a").ClearContents
If Len(InString) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "Too many permutations!"
Exit Sub
Else
ActiveSheet.Columns(1).Cle
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
JackOfPH
https://www.experts-exchange.com/questions/21893696/How-to-make-this-looping-faster.html
Hi,
I would just dump everything into a dictionary (include the microsoft scripting runtime library) and if it exists then not repeat it then just go through and output everything in the array
ie
Dim CurrentRow
Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
Range("a:a").ClearContents
If Len(InString) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "Too many permutations!"
Exit Sub
Else
ActiveSheet.Columns(1).Cle
CurrentRow = 1
Dim n As New Dictionary
Call GetPermutation("", InString, n)
End If
End Sub
Sub GetPermutation(x As String, y As String, n As Dictionary)
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
If n.Exists(x & y) = False Then
Cells(CurrentRow, 1) = x & y
CurrentRow = CurrentRow + 1
n.Add x & y, 1
End If
Else
For i = 1 To j
Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i), n)
Next
End If
End Sub
I would just dump everything into a dictionary (include the microsoft scripting runtime library) and if it exists then not repeat it then just go through and output everything in the array
ie
Dim CurrentRow
Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
Range("a:a").ClearContents
If Len(InString) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "Too many permutations!"
Exit Sub
Else
ActiveSheet.Columns(1).Cle
CurrentRow = 1
Dim n As New Dictionary
Call GetPermutation("", InString, n)
End If
End Sub
Sub GetPermutation(x As String, y As String, n As Dictionary)
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
If n.Exists(x & y) = False Then
Cells(CurrentRow, 1) = x & y
CurrentRow = CurrentRow + 1
n.Add x & y, 1
End If
Else
For i = 1 To j
Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i), n)
Next
End If
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.