Combinations

Topic

New Reply

How can I create a procedure that will create all the combinations of the numbers 0 to 9? E.g. 0123456789, 1023456789,.. I will store them one by one in a column array. Cheers, Andy.

Reply | Quote

Replies

Beware that the following is going to run for a LONG time.

Public Sub AllNums()
Dim I0 As Integer, I1 As Integer, I2 As Integer, I3 As Integer, I4 As Integer
Dim I5 As Integer, I6 As Integer, I7 As Integer, I8 As Integer, I9 As Integer
Dim strNumber As String
    For I0 = 0 To 9
      For I1 = 0 To 9
        For I2 = 0 To 9
          For I3 = 0 To 9
            For I4 = 0 To 9
              For I5 = 0 To 9
                For I6 = 0 To 9
                  For I7 = 0 To 9
                    For I8 = 0 To 9
                      For I9 = 0 To 9
                        strNumber = CStr(I0) & CStr(I1) & CStr(I2) & CStr(I3)
                        strNumber = strNumber & CStr(I4) & CStr(I5) & CStr(I6)
                        strNumber = strNumber & CStr(I7) & CStr(I8) & CStr(I9)
                      Next I9
                    Next I8
                  Next I7
                Next I6
              Next I5
            Next I4
          Next I3
        Next I2
      Next I1
    Next I0
End Sub

Reply | Quote

Leagre,

Would that code just give every number between 1 and 9999999999, rather than every combination of 10 digits (ie, with no repeating digits)- which is the way I see the question (I may be wrong though).

Otherwise, the following might do the same:

For i = 1 To 9999999999
  strNumber = Format(i, "0000000000")
Next

Otherwise, the code might me changed to:

    For I0 = 0 To 9
      For I1 = 0 To 9
        If I1  I0 Then
          For I2 = 0 To 9
            If I2  I1 And I2  I0 Then

etc.

I’m sure thought theres a better way.

Reply | Quote

Geoff: If you start your For loop at zero instead of 1, then your code and mine will produce the same results. However, yours is much simpler and will probably run faster, depending on how fast Format is.

If you don’t want duplicate digits, then your example should do that also.

Reply | Quote

Geoff’s code seems to be heading along the right lines – I do want to avoid duplicate digits. However, I was hoping there was a simpler way of coding it??

Reply | Quote

The following code seems to be doing what I want. It still seems slow though??

Sub Combs()
Dim strNumber As String
Dim varCombs As Variant
Dim intCounter As Integer

For varCombs = 123456789 To 9876543210#
strNumber = CStr(Format(varCombs, “0000000000”))
For intCounter = 1 To 9
If InStr(Right(strNumber, 10 – intCounter), Mid(strNumber, intCounter, 1)) > 0 Then
GoTo SkipNumber
End If
Next intCounter
Debug.Print strNumber
SkipNumber:
Next varCombs
End Sub

This code generates the entire sequence of numbers, then performs string comparisons to if the generated number contains duplicates. Any other ideas?

Reply | Quote

The following code generates all the permutations directly. It could probably be improved by more expert VBA’ers.

The last line of output for n=9 on a PIII at 800Mhz or so was:

Total = 362880 in 183.1543 seconds. (1981.28029858704/sec.)

so n=10 would take 10 times this – about 30 minutes. 40 seconds of this is generating the permutations and the other 29m20s is printing them out!

Ian.

Sub Caller()
Dim iPerm() As Integer
Dim k As Long
Dim strPrint As String
Dim Start As Single

n = InputBox("Number of items")
Start = Timer
ReDim iPerm(1 To n)
For i = 1 To n
    iPerm(i) = i
Next i
k = 0
Do While iPerm(1)  0
    k = k + 1
    strPrint = ""
    For i = 1 To n
        strPrint = strPrint & (iPerm(i) - 1)
    Next i
    Debug.Print strPrint & "   " & k
    iPerm = NextPerm(iPerm)
Loop
Debug.Print ("Total = " & k & " in " & (Timer - Start) & "seconds. (" & k / (Timer - Start) & "/sec.)")
End Sub
'
'
Function NextPerm(iPerm() As Integer) As Variant
' iPerm() contains a permutation of 1 2 3 ... n
' NextPerm returns the next permutation of 1 2 ... n after iPerm
' or sets iPerm(1) to 0 if iPerm is the last permutation
' n n-1 ... 1

Dim SubSet() As Integer
Dim n As Integer

n = UBound(iPerm)

If iPerm(1) < n Then 'Shift n left by one place
    For j = 2 To n
        If iPerm(j) = n Then
            iPerm(j) = iPerm(j - 1)
            iPerm(j - 1) = n
            NextPerm = iPerm
            Exit Function
        End If
    Next j
Else
    If n = 2 Then 'Done
        iPerm(1) = 0
        NextPerm = iPerm
        Exit Function
    End If
    ' Get the next permutation of 1 ... (n-1)
    ' and add n at the end
    ReDim SubSet(1 To (n - 1))
    For j = 1 To n - 1
        SubSet(j) = iPerm(j + 1)
    Next j
    SubSet = NextPerm(SubSet)
    If SubSet(1) = 0 Then
        iPerm(1) = 0
        NextPerm = iPerm
        Exit Function
    End If
    For j = 1 To n - 1
        iPerm(j) = SubSet(j)
    Next j
    iPerm(n) = n
    NextPerm = iPerm
End If
End Function

Reply | Quote