ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Generate permutations but delete double entries (https://www.excelbanter.com/excel-programming/358721-generate-permutations-but-delete-double-entries.html)

as_sass[_11_]

Generate permutations but delete double entries
 

Hi all,

Some time ago I got a macro from this forum that generates permutations
from a string of numbers (see code below).

The problem is that the macro will only do this for strings <= 8 digits
long, as it pastes the permutations in a column and then hits the
maximum number of rows it can fill.

Is there a way to

a) make the macro not generate double entries (i.e., when I ask for the
permutations for '121', this macro returns 121 and 121...)

b) make the macro print out the permutations as a text file, rather
than paste it into excel? Alternatively, maybe start a new column once
the max number of rows is reached?)

Your help, as always, is greatly appreciated.

sass



Dim CurrentRow

Sub GetString()
Dim InString As String
InString = Sheets("Sheet1").Range("B1")
ActiveSheet.Columns(1).Clear
CurrentRow = 1
Call GetPermutation("", InString)
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



--
as_sass
------------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...fo&userid=9065
View this thread: http://www.excelforum.com/showthread...hreadid=532337


Tom Ogilvy

Generate permutations but delete double entries
 
Sub GetString()
Dim InString As String, Dim ff as Long
InString = Sheets("Sheet1").Range("B1")
ActiveSheet.Columns(1).Clear
CurrentRow = 1
ff = freefile
Open "C:\Myfiles\MyPerms.txt" for Output as #ff
Call GetPermutation("", InString,ff)
Close #ff
End Sub

Sub GetPermutation(x As String, y As String, ff as Long)
' 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
Print #ff, 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

The way this operates really doesn't look at the values in the string, so
you would have to store all the values generated and not write out the value
if it matches something already used. You could do this with a dictionary
object or collection object.

See an example of this approach using a collection at J-walks site (where
you probably got the permutation code originally)

http://www.j-walk.com/ss/excel/tips/tip47.htm

--
Regards,
Tom Ogilvy


"as_sass" wrote:


Hi all,

Some time ago I got a macro from this forum that generates permutations
from a string of numbers (see code below).

The problem is that the macro will only do this for strings <= 8 digits
long, as it pastes the permutations in a column and then hits the
maximum number of rows it can fill.

Is there a way to

a) make the macro not generate double entries (i.e., when I ask for the
permutations for '121', this macro returns 121 and 121...)

b) make the macro print out the permutations as a text file, rather
than paste it into excel? Alternatively, maybe start a new column once
the max number of rows is reached?)

Your help, as always, is greatly appreciated.

sass



Dim CurrentRow

Sub GetString()
Dim InString As String
InString = Sheets("Sheet1").Range("B1")
ActiveSheet.Columns(1).Clear
CurrentRow = 1
Call GetPermutation("", InString)
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



--
as_sass
------------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...fo&userid=9065
View this thread: http://www.excelforum.com/showthread...hreadid=532337



as_sass[_12_]

Generate permutations but delete double entries
 

Tom,

Thanks for the prompt reply!

I think I know how it is supposed to work, but I get the following
error message:

Compile Error: Argument not optional.

In the code of of GetPermutation(), the following line gets
highlighted:

Call GetPermutation(x + Mid(y, i, 1), _

Any ideas?

Thanks,

sass


--
as_sass
------------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...fo&userid=9065
View this thread: http://www.excelforum.com/showthread...hreadid=532337


Dave Peterson

Generate permutations but delete double entries
 
Change this:

Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i))

to:

Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i), ff)

as_sass wrote:

Tom,

Thanks for the prompt reply!

I think I know how it is supposed to work, but I get the following
error message:

Compile Error: Argument not optional.

In the code of of GetPermutation(), the following line gets
highlighted:

Call GetPermutation(x + Mid(y, i, 1), _

Any ideas?

Thanks,

sass

--
as_sass
------------------------------------------------------------------------
as_sass's Profile: http://www.excelforum.com/member.php...fo&userid=9065
View this thread: http://www.excelforum.com/showthread...hreadid=532337


--

Dave Peterson


All times are GMT +1. The time now is 07:44 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com