Pairs, Triplets, Quads...

M

Mike NG

I know this isn't strictly an excel problem, but there may be some neat
way of doing it

I have an array of characters Chars(cSize) - upper limit being
controlled by a constant. Let's say cSize is 5 and the array contains A
B C D E

I need to output Pairs, Triplets, Quads... dynamically depending on the
value of cSize, e.g.

Pairs
AB AC AD AE BC BD BE CD DE DE

Triplets
ABC ABD ABE BCD BCE CDE

Quads
ABCD ABCE BCDE


Pairs are easy as this will always be
for i = 1 to cSize - 1
for j = i+1 to cSize
msgbox chars(i)&chars(j)
next
next

Triples are similar
for i = 1 to cSize - 2
for j = i+1 to cSize -1
for k = j+1 to cSize
msgbox chars(i)&chars(j)&chars(k)
next
next
next

and so on

I don't really want to be coding for all eventualities, so is there any
way of making this general?
 
M

Mike NG

I know this isn't strictly an excel problem, but there may be some neat
way of doing it

I have an array of characters Chars(cSize) - upper limit being
controlled by a constant. Let's say cSize is 5 and the array contains A
B C D E

I need to output Pairs, Triplets, Quads... dynamically depending on the
value of cSize, e.g.

Pairs
AB AC AD AE BC BD BE CD DE DE

Triplets
ABC ABD ABE BCD BCE CDE

Quads
ABCD ABCE BCDE


Pairs are easy as this will always be
for i = 1 to cSize - 1
for j = i+1 to cSize
msgbox chars(i)&chars(j)
next
next

Triples are similar
for i = 1 to cSize - 2
for j = i+1 to cSize -1
for k = j+1 to cSize
msgbox chars(i)&chars(j)&chars(k)
next
next
next

and so on

I don't really want to be coding for all eventualities, so is there any
way of making this general?
Click to expand...
I've just had a thought how to do this, but I just need a bit of help
with binary manipulation....

If I allocate each element a binary digit and count up

A B C D E
0 0 0 0 0 - no bits set, not a valid pair
0 0 0 0 1 - 1 bit set, not a valid pair
0 0 0 1 0 - 1 bit set, not a valid pair
0 0 0 1 1 - 2 bits set, a valid pair
0 0 1 0 0 - 1 bit set, not a valid pair
0 0 1 0 1 - 2 bits set, a valid pair
0 0 1 1 0 - 2 bits set, a valid pair
0 0 1 1 1 - 3 bits set, not a valid pair

Obviously I will be counting up in base 10, so how do I detect the
number of "on Bits" in the value
 
M

Mike NG

Obviously I will be counting up in base 10, so how do I detect the number
of "on Bits" in the value
Click to expand...
I found this function written by Chip Pearson which will do the trick

Function DecToBin(D As String) As String
Dim N As Long
Dim Res As String
For N = 31 To 1 Step -1
Res = Res & IIf(CLng(D) And 2 ^ (N - 1), "1", "0")
Next N
N = InStr(1, Res, "1")
DecToBin = Mid(Res, IIf(N > 0, N, Len(Res)))
End Function
 
D

Dana DeLouis

Hi. Just throwing this out. Is ACD & ACE etc. valid for triplets?
How about ABDE etc. for Quads?
 
M

Mike NG

Hi. Just throwing this out. Is ACD & ACE etc. valid for triplets?
How about ABDE etc. for Quads?
Click to expand...
Sorry yes they are

Thinking about this, binary may not be an ideal solution cos of the
upper limit on longs
 
T

Tushar Mehta

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.

The following should do the job:

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
T

Tushar Mehta

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.

The following should do the job:

Option Explicit
Function ArrLen(Arr)
ArrLen = UBound(Arr) - LBound(Arr) + 1
End Function
Function FirstEmptyCol(FirstCell As Range) As Byte
If IsEmpty(FirstCell.Value) Then
FirstEmptyCol = FirstCell.Column
ElseIf IsEmpty(FirstCell.Offset(0, 1).Value) Then
FirstEmptyCol = FirstCell.Column + 1
Else
FirstEmptyCol = FirstCell.End(xlToRight).Offset(0, 1).Column
End If
End Function
Sub doOneLevel(ByVal preString As String, _
FirstElementIdx As Byte, Arr() As String, FirstCell As Range)
Dim I As Byte, CellIdx As Byte
If FirstElementIdx > UBound(Arr) Then
Else
CellIdx = FirstEmptyCol(FirstCell) - 1
For I = FirstElementIdx To UBound(Arr)
FirstCell.Offset(0, CellIdx).Value = preString & Arr(I)
CellIdx = CellIdx + 1
doOneLevel preString & Arr(I), I + 1, _
Arr(), FirstCell.Offset(1, 0)
Next I
End If
End Sub
Sub getGoing()
Dim Arr(0 To 4) As String
Arr(0) = "A": Arr(1) = "B": Arr(2) = "C": Arr(3) = "D":
Arr(4) = "E"
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

I also tested it with 6 elements A..F

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
M

Mike NG

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.
Click to expand...
Ah that wasn't really necessary!

The following should do the job:
Click to expand...
Very neat thank you

I also tested it with 6 elements A..F
Click to expand...
However I will need to convert this to use memory, since A..I blows it
away as it tries to go beyond the edge of the spreadsheet
 
T

Tushar Mehta

Ah that wasn't really necessary!


Very neat thank you
You are welcome.

However I will need to convert this to use memory, since A..I blows it
away as it tries to go beyond the edge of the spreadsheet
Click to expand...

Switching row and column references shouldn't be that difficult. ;-)
Watch out for those 'Byte's

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
T

Tushar Mehta

Actually, A..I doesn't 'blow it away.' The number of combinations for
each possible combination is given by COMBIN(9,i) for i=1..9 and the
largest value is 126.

What must have happened is that you ran the code for multiple
combinations one after the other. You have to clear the activesheet's
cell(1,1)'s currentregion before running the main routine.

Also, the main routine can be cleaned up a bit with
Sub getGoing()
'Dim Arr(0 To 5) As String
'Arr(0) = "A": Arr(1) = "B": Arr(2) = "C"
'Arr(3) = "D": Arr(4) = "E": Arr(5) = "F"
Dim Arr() As String
Arr = Split("A,B,C,D,E,F,G,H,I", ",")
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

Though, now, it only works with VB6 (XL2000 or higher).

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
M

Mike NG

Actually, A..I doesn't 'blow it away.' The number of combinations for
each possible combination is given by COMBIN(9,i) for i=1..9 and the
largest value is 126.
Click to expand...
Yes sorry
What must have happened is that you ran the code for multiple
combinations one after the other. You have to clear the activesheet's
cell(1,1)'s currentregion before running the main routine.
Click to expand...
Yes that was the problem
Also, the main routine can be cleaned up a bit with
Sub getGoing()
'Dim Arr(0 To 5) As String
'Arr(0) = "A": Arr(1) = "B": Arr(2) = "C"
'Arr(3) = "D": Arr(4) = "E": Arr(5) = "F"
Dim Arr() As String
Arr = Split("A,B,C,D,E,F,G,H,I", ",")
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

Though, now, it only works with VB6 (XL2000 or higher).
Click to expand...
That's what I have here :)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA / STEMP Question 3
VBA Question / 2
Pattern / Combinations 6
Excel How to find the most common pairs and triplets numbers? 5
averaging non-contiguous data using arrays 1
Inaccurate count with code 6
Incorporating feature of second macro into first? 5
Runtime Error 1004 on Linest 7

Top