request for help, modify
the macro to the values
3333333 = 7
so the example macrode below is at 444444
ie 6 boxes, the request is to modify
for seven houses up to 3
then it will be 0000000- 3333333 =
7 positions
0000000
0000001
0000002
0000003
0000011
......
3333333
cannot have repetitions = ex = 0000100 or 0100000
or 0000010 = only a single leave = 0000001
MODIFY= 7 0000000- 3333333
Sub comb_0_444444()
Dim comb(444444), n(6)
rw = 1
For r = 0 To 4: For s = 0 To 4: For t = 0 To 4: For u = 0 To 4: For v = 0 To 4: For w = 0 To 4
GoSub sort
comb(n(1) & n(2) & n(3) & n(4) & n(5) & n(6)) = 1
Next w: Next v: Next u: Next t: Next s: Next r
For x = 0 To 444444: If comb(x) = 1 Then Cells(rw, 1) = x: rw = rw + 1
Next x
Exit Sub
sort: 'sort r-w lsd to msd return n1-n6
p = 6
For q = 4 To 0 Step -1
If r = q Then n(p) = q: p = p - 1
If s = q Then n(p) = q: p = p - 1
If t = q Then n(p) = q: p = p - 1
If u = q Then n(p) = q: p = p - 1
If v = q Then n(p) = q: p = p - 1
If w = q Then n(p) = q: p = p - 1
If p = 0 Then q = 0
Next q
Return
End Sub
EDIT:
ok if you can build
the macro, for various formats
44444, 5555555 etc would be great
would go on excel sheet with button
to modify for various arrays,
but if not possible
only 0000000-3333333,
It's great
the macro to the values
3333333 = 7
so the example macrode below is at 444444
ie 6 boxes, the request is to modify
for seven houses up to 3
then it will be 0000000- 3333333 =
7 positions
0000000
0000001
0000002
0000003
0000011
......
3333333
cannot have repetitions = ex = 0000100 or 0100000
or 0000010 = only a single leave = 0000001
MODIFY= 7 0000000- 3333333
Sub comb_0_444444()
Dim comb(444444), n(6)
rw = 1
For r = 0 To 4: For s = 0 To 4: For t = 0 To 4: For u = 0 To 4: For v = 0 To 4: For w = 0 To 4
GoSub sort
comb(n(1) & n(2) & n(3) & n(4) & n(5) & n(6)) = 1
Next w: Next v: Next u: Next t: Next s: Next r
For x = 0 To 444444: If comb(x) = 1 Then Cells(rw, 1) = x: rw = rw + 1
Next x
Exit Sub
sort: 'sort r-w lsd to msd return n1-n6
p = 6
For q = 4 To 0 Step -1
If r = q Then n(p) = q: p = p - 1
If s = q Then n(p) = q: p = p - 1
If t = q Then n(p) = q: p = p - 1
If u = q Then n(p) = q: p = p - 1
If v = q Then n(p) = q: p = p - 1
If w = q Then n(p) = q: p = p - 1
If p = 0 Then q = 0
Next q
Return
End Sub
EDIT:
ok if you can build
the macro, for various formats
44444, 5555555 etc would be great
would go on excel sheet with button
to modify for various arrays,
but if not possible
only 0000000-3333333,
It's great
Last edited by a moderator: