| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Formula or Code Needed
Is there anyone can help me to code the module?
I have 4 columns of data (A:D) . Each column contains 5 rows (1-5).Each column contain 1 unique nos. This is for generating Jackpot combinations, i.e. 6 numbers in a group. The condition is that the group generated must contain two pair numbers from column A:D and two single numbers from column A:D. In another word the maximum numbers can get from each column is 2 numbers and the minimun number is 1 number. The combinations must come from 4 columns. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Formula or Code Needed
this is the third time you posted this. If you are not getting any answers,
either people are not interested or they don't know what you are asking. I would suggest that people don't know what your are asking. I can say I don't have a clue what you want. you talk about unique numbers and two pair numbers and two single numbers - frankly, none of it makes any sense in explaining what want. Perhaps if you give a detailed example, that shows what you have, what it means, and what you want to achieve - what the output would look like based on what you have - you would get an answer. -- Regards, Tom Ogilvy "Michael168" wrote in message ... Is there anyone can help me to code the module? I have 4 columns of data (A:D) . Each column contains 5 rows (1-5).Each column contain 1 unique nos. This is for generating Jackpot combinations, i.e. 6 numbers in a group. The condition is that the group generated must contain two pair numbers from column A:D and two single numbers from column A:D. In another word the maximum numbers can get from each column is 2 numbers and the minimun number is 1 number. The combinations must come from 4 columns. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Formula or Code Needed
Hello Mr.Tom Ogilvy
Thanks for your comments. Below is what I want. Col A (1-5) contains 1,2,3,4,5 Col B (1-5) contains 6,7,8,9,10 Col C (1-5) contains 11,12,13,14,15 Col D (1-5) contains 16,17,18,19,20 What I want is from col A-D I want to generate groups of numbers consisting of 6 unique nos under the conditions that each group of nos must contains max of 2 nos from either two of the columns and 1 no each from the other 2 columns. I hope you can get what I mean. e.g. 1st group= 1,2,6,7,11,16 2nd group= 1,2,6,11,12,17 3rd group=2,6,7,13,17,18 and so on.... until the combination complete with the above conditions of forming the groups of nos. What I mean unique is that each group of 6 nos does not repeated itself. Thank you ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Formula or Code Needed
Option Explicit
Sub tester9() Dim bWrite As Boolean Dim arr(0 To 19) As Long Dim arr1(1 To 6) As Long Dim arr2(0 To 19) As Long Dim col(1 To 4) As Long Dim cnt As Long, ii As Long Dim j As Long, i As Long, k As Long Dim m As Long, cell As Range, colm As Range 'Dim sStr as String i = -1 For Each colm In Range("A1:D5").Columns For Each cell In colm.Cells i = i + 1 arr2(i) = cell.Value Next Next j = 7 For i = 1 To 2 ^ 20 - 1 bldArr i, arr, cnt If cnt = 6 Then For ii = 1 To 4 col(ii) = 0 arr1(ii) = Empty Next arr1(5) = Empty arr1(6) = Empty m = 1 ' sStr = "" For k = 0 To 19 ' sStr = sStr & arr(k) If arr(k) = 1 Then arr1(m) = arr2(k) m = m + 1 bWrite = False Select Case k Case 0, 1, 2, 3, 4 col(1) = col(1) + 1 If col(1) 2 Then Exit For Case 5, 6, 7, 8, 9 col(2) = col(2) + 1 If col(2) 2 Then Exit For Case 10, 11, 12, 13, 14 col(3) = col(3) + 1 If col(3) 2 Then Exit For Case 15, 16, 17, 18, 19 col(4) = col(4) + 1 If col(4) 2 Then Exit For End Select bWrite = True End If Next ' Debug.Print i, sStr, m For ii = 1 To 4 If col(ii) = 0 Then bWrite = False Exit For End If Next If bWrite Then Cells(j, 1).Resize(1, 6).Value = arr1 Cells(j, 7) = i Cells(j, 8).Resize(1, 20) = arr j = j + 1 End If End If Next End Sub Sub bldArr(num As Long, arr() As Long, cnt As Long) Dim lNum As Long, i As Long lNum = num ' Dim sStr As String ' sStr = "" cnt = 0 For i = 19 To 0 Step -1 If lNum And 2 ^ i Then cnt = cnt + 1 arr(19 - i) = 1 ' sStr = sStr & "1" If cnt 6 Then Exit Sub Else arr(19 - i) = 0 ' sStr = sStr & "0" End If Next ' If cnt = 2 Then ' Debug.Print num, sStr ' End If End Sub -- Regards, Tom Ogilvy Michael168 wrote in message ... Hello Mr.Tom Ogilvy Thanks for your comments. Below is what I want. Col A (1-5) contains 1,2,3,4,5 Col B (1-5) contains 6,7,8,9,10 Col C (1-5) contains 11,12,13,14,15 Col D (1-5) contains 16,17,18,19,20 What I want is from col A-D I want to generate groups of numbers consisting of 6 unique nos under the conditions that each group of nos must contains max of 2 nos from either two of the columns and 1 no each from the other 2 columns. I hope you can get what I mean. e.g. 1st group= 1,2,6,7,11,16 2nd group= 1,2,6,11,12,17 3rd group=2,6,7,13,17,18 and so on.... until the combination complete with the above conditions of forming the groups of nos. What I mean unique is that each group of 6 nos does not repeated itself. Thank you ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Formula or Code Needed
Ignore that one. It writes out some information you don't need. I have
commented out those lines in this version: Dim arr(0 To 19) As Long Dim arr1(1 To 6) As Long Dim arr2(0 To 19) As Long Dim col(1 To 4) As Long Dim cnt As Long, ii As Long Dim j As Long, i As Long, k As Long Dim m As Long, cell As Range, colm As Range 'Dim sStr as String i = -1 For Each colm In Range("A1:D5").Columns For Each cell In colm.Cells i = i + 1 arr2(i) = cell.Value Next Next j = 7 For i = 1 To 2 ^ 20 - 1 bldArr i, arr, cnt If cnt = 6 Then For ii = 1 To 4 col(ii) = 0 arr1(ii) = Empty Next arr1(5) = Empty arr1(6) = Empty m = 1 ' sStr = "" For k = 0 To 19 ' sStr = sStr & arr(k) If arr(k) = 1 Then arr1(m) = arr2(k) m = m + 1 bWrite = False Select Case k Case 0, 1, 2, 3, 4 col(1) = col(1) + 1 If col(1) 2 Then Exit For Case 5, 6, 7, 8, 9 col(2) = col(2) + 1 If col(2) 2 Then Exit For Case 10, 11, 12, 13, 14 col(3) = col(3) + 1 If col(3) 2 Then Exit For Case 15, 16, 17, 18, 19 col(4) = col(4) + 1 If col(4) 2 Then Exit For End Select bWrite = True End If Next ' Debug.Print i, sStr, m For ii = 1 To 4 If col(ii) = 0 Then bWrite = False Exit For End If Next If bWrite Then Cells(j, 1).Resize(1, 6).Value = arr1 ' Cells(j, 7) = i ' Cells(j, 8).Resize(1, 20) = arr j = j + 1 End If End If Next End Sub Sub bldArr(num As Long, arr() As Long, cnt As Long) Dim lNum As Long, i As Long lNum = num ' Dim sStr As String ' sStr = "" cnt = 0 For i = 19 To 0 Step -1 If lNum And 2 ^ i Then cnt = cnt + 1 arr(19 - i) = 1 ' sStr = sStr & "1" If cnt 6 Then Exit Sub Else arr(19 - i) = 0 ' sStr = sStr & "0" End If Next ' If cnt = 2 Then ' Debug.Print num, sStr ' End If End Sub -- Regards, Tom Ogilvy Tom Ogilvy wrote in message ... Option Explicit Sub tester9() Dim bWrite As Boolean Dim arr(0 To 19) As Long Dim arr1(1 To 6) As Long Dim arr2(0 To 19) As Long Dim col(1 To 4) As Long Dim cnt As Long, ii As Long Dim j As Long, i As Long, k As Long Dim m As Long, cell As Range, colm As Range 'Dim sStr as String i = -1 For Each colm In Range("A1:D5").Columns For Each cell In colm.Cells i = i + 1 arr2(i) = cell.Value Next Next j = 7 For i = 1 To 2 ^ 20 - 1 bldArr i, arr, cnt If cnt = 6 Then For ii = 1 To 4 col(ii) = 0 arr1(ii) = Empty Next arr1(5) = Empty arr1(6) = Empty m = 1 ' sStr = "" For k = 0 To 19 ' sStr = sStr & arr(k) If arr(k) = 1 Then arr1(m) = arr2(k) m = m + 1 bWrite = False Select Case k Case 0, 1, 2, 3, 4 col(1) = col(1) + 1 If col(1) 2 Then Exit For Case 5, 6, 7, 8, 9 col(2) = col(2) + 1 If col(2) 2 Then Exit For Case 10, 11, 12, 13, 14 col(3) = col(3) + 1 If col(3) 2 Then Exit For Case 15, 16, 17, 18, 19 col(4) = col(4) + 1 If col(4) 2 Then Exit For End Select bWrite = True End If Next ' Debug.Print i, sStr, m For ii = 1 To 4 If col(ii) = 0 Then bWrite = False Exit For End If Next If bWrite Then Cells(j, 1).Resize(1, 6).Value = arr1 Cells(j, 7) = i Cells(j, 8).Resize(1, 20) = arr j = j + 1 End If End If Next End Sub Sub bldArr(num As Long, arr() As Long, cnt As Long) Dim lNum As Long, i As Long lNum = num ' Dim sStr As String ' sStr = "" cnt = 0 For i = 19 To 0 Step -1 If lNum And 2 ^ i Then cnt = cnt + 1 arr(19 - i) = 1 ' sStr = sStr & "1" If cnt 6 Then Exit Sub Else arr(19 - i) = 0 ' sStr = sStr & "0" End If Next ' If cnt = 2 Then ' Debug.Print num, sStr ' End If End Sub -- Regards, Tom Ogilvy Michael168 wrote in message ... Hello Mr.Tom Ogilvy Thanks for your comments. Below is what I want. Col A (1-5) contains 1,2,3,4,5 Col B (1-5) contains 6,7,8,9,10 Col C (1-5) contains 11,12,13,14,15 Col D (1-5) contains 16,17,18,19,20 What I want is from col A-D I want to generate groups of numbers consisting of 6 unique nos under the conditions that each group of nos must contains max of 2 nos from either two of the columns and 1 no each from the other 2 columns. I hope you can get what I mean. e.g. 1st group= 1,2,6,7,11,16 2nd group= 1,2,6,11,12,17 3rd group=2,6,7,13,17,18 and so on.... until the combination complete with the above conditions of forming the groups of nos. What I mean unique is that each group of 6 nos does not repeated itself. Thank you ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Formula or Code Needed
Oops, now I left out the first two lines: Hopefully this will run if you
copy and paste it from the email. Sub tester9() Dim bWrite As Boolean Dim arr(0 To 19) As Long Dim arr1(1 To 6) As Long Dim arr2(0 To 19) As Long Dim col(1 To 4) As Long Dim cnt As Long, ii As Long Dim j As Long, i As Long, k As Long Dim m As Long, cell As Range, colm As Range 'Dim sStr as String i = -1 For Each colm In Range("A1:D5").Columns For Each cell In colm.Cells i = i + 1 arr2(i) = cell.Value Next Next j = 7 For i = 1 To 2 ^ 20 - 1 bldArr i, arr, cnt If cnt = 6 Then For ii = 1 To 4 col(ii) = 0 arr1(ii) = Empty Next arr1(5) = Empty arr1(6) = Empty m = 1 ' sStr = "" For k = 0 To 19 ' sStr = sStr & arr(k) If arr(k) = 1 Then arr1(m) = arr2(k) m = m + 1 bWrite = False Select Case k Case 0, 1, 2, 3, 4 col(1) = col(1) + 1 If col(1) 2 Then Exit For Case 5, 6, 7, 8, 9 col(2) = col(2) + 1 If col(2) 2 Then Exit For Case 10, 11, 12, 13, 14 col(3) = col(3) + 1 If col(3) 2 Then Exit For Case 15, 16, 17, 18, 19 col(4) = col(4) + 1 If col(4) 2 Then Exit For End Select bWrite = True End If Next ' Debug.Print i, sStr, m For ii = 1 To 4 If col(ii) = 0 Then bWrite = False Exit For End If Next If bWrite Then Cells(j, 1).Resize(1, 6).Value = arr1 ' Cells(j, 7) = i ' Cells(j, 8).Resize(1, 20) = arr j = j + 1 End If End If Next End Sub Sub bldArr(num As Long, arr() As Long, cnt As Long) Dim lNum As Long, i As Long lNum = num ' Dim sStr As String ' sStr = "" cnt = 0 For i = 19 To 0 Step -1 If lNum And 2 ^ i Then cnt = cnt + 1 arr(19 - i) = 1 ' sStr = sStr & "1" If cnt 6 Then Exit Sub Else arr(19 - i) = 0 ' sStr = sStr & "0" End If Next ' If cnt = 2 Then ' Debug.Print num, sStr ' End If End Sub -- Regards, Tom Ogilvy |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Help needed with VBA code | Excel Discussion (Misc queries) | |||
| VBA code help needed | Excel Discussion (Misc queries) | |||
| formula / code help needed | Excel Discussion (Misc queries) | |||
| Excel Formula or VBA code help needed | Excel Programming | |||
| VBA code or formula needed to identify certain records in a database | Excel Programming | |||
![Michael168[_6_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
