| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Permutations
Hi,
In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Permutations
Code for Permutations & Combinations:
Option Explicit Dim vAllItems As Variant Dim Buffer() As String Dim BufferPtr As Long Dim Results As Worksheet Sub ListPermutations() ' To use it, you put the letter C or P (for combinations or permutations) in ' a cell. The cell below that contains the number of items in a subset. The ' Cells below are a list of the items that make up the population. They could be ' numbers, letters and symbols, or words, etc. ' You select the top cell, or the entire range and run the sub. The subsets ' are written to a new sheet in the workbook. Dim rng As Range Dim PopSize As Integer Dim SetSize As Integer Dim Which As String Dim n As Double Const BufferSize As Long = 4096 Set rng = Selection.Columns(1).Cells If rng.Cells.Count = 1 Then Set rng = Range(rng, rng.End(xlDown)) End If PopSize = rng.Cells.Count - 2 If PopSize < 2 Then GoTo DataError SetSize = rng.Cells(2).Value If SetSize PopSize Then GoTo DataError Which = UCase$(rng.Cells(1).Value) Select Case Which Case "C" n = Application.WorksheetFunction.Combin(PopSize, SetSize) Case "P" n = Application.WorksheetFunction.Permut(PopSize, SetSize) Case Else GoTo DataError End Select If n Cells.Count Then GoTo DataError Application.ScreenUpdating = False Set Results = Worksheets.Add vAllItems = rng.Offset(2, 0).Resize(PopSize).Value ReDim Buffer(1 To BufferSize) As String BufferPtr = 0 If Which = "C" Then AddCombination PopSize, SetSize Else AddPermutation PopSize, SetSize End If vAllItems = 0 Application.ScreenUpdating = True Exit Sub DataError: If n = 0 Then Which = "Enter your data in a vertical range of at least 4 cells. " _ & String$(2, 10) _ & "Top cell must contain the letter C or P, 2nd cell is the number " _ & "of items in a subset, the cells below are the values from which " _ & "the subset is to be chosen." Else Which = "This requires " & Format$(n, "#,##0") & _ " cells, more than are available on the worksheet!" End If MsgBox Which, vbOKOnly, "DATA ERROR" Exit Sub End Sub Private Sub AddPermutation(Optional PopSize As Integer = 0, _ Optional SetSize As Integer = 0, _ Optional NextMember As Integer = 0) Static iPopSize As Integer Static iSetSize As Integer Static SetMembers() As Integer Static Used() As Integer Dim i As Integer If PopSize < 0 Then iPopSize = PopSize iSetSize = SetSize ReDim SetMembers(1 To iSetSize) As Integer ReDim Used(1 To iPopSize) As Integer NextMember = 1 End If For i = 1 To iPopSize If Used(i) = 0 Then SetMembers(NextMember) = i If NextMember < iSetSize Then Used(i) = True AddPermutation , , NextMember + 1 Used(i) = False Else SavePermutation SetMembers() End If End If Next i If NextMember = 1 Then SavePermutation SetMembers(), True Erase SetMembers Erase Used End If End Sub 'AddPermutation Private Sub AddCombination(Optional PopSize As Integer = 0, _ Optional SetSize As Integer = 0, _ Optional NextMember As Integer = 0, _ Optional NextItem As Integer = 0) Static iPopSize As Integer Static iSetSize As Integer Static SetMembers() As Integer Dim i As Integer If PopSize < 0 Then iPopSize = PopSize iSetSize = SetSize ReDim SetMembers(1 To iSetSize) As Integer NextMember = 1 NextItem = 1 End If For i = NextItem To iPopSize SetMembers(NextMember) = i If NextMember < iSetSize Then AddCombination , , NextMember + 1, i + 1 Else SavePermutation SetMembers() End If Next i If NextMember = 1 Then SavePermutation SetMembers(), True Erase SetMembers End If End Sub 'AddCombination Private Sub SavePermutation(ItemsChosen() As Integer, _ Optional FlushBuffer As Boolean = False) Dim i As Integer, sValue As String Static RowNum As Long, ColNum As Long If RowNum = 0 Then RowNum = 1 If ColNum = 0 Then ColNum = 1 If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then If BufferPtr 0 Then If (RowNum + BufferPtr - 1) Rows.Count Then RowNum = 1 ColNum = ColNum + 1 If ColNum 256 Then Exit Sub End If Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _ = Application.WorksheetFunction.Transpose(Buffer()) RowNum = RowNum + BufferPtr End If BufferPtr = 0 If FlushBuffer = True Then Erase Buffer RowNum = 0 ColNum = 0 Exit Sub Else ReDim Buffer(1 To UBound(Buffer)) End If End If 'construct the next set For i = 1 To UBound(ItemsChosen) sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1) Next i 'and save it in the buffer BufferPtr = BufferPtr + 1 Buffer(BufferPtr) = Mid$(sValue, 3) End Sub 'SavePermutation "Dave" wrote: Hi, In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Permutations
Try this worksheet code.
A couple of points. It uses whetver is in column A as the numbers to perm and the code include no validation. You should therefore set up some data validation to ensure unique positive numbers and no text. In it's current form it will perm a maxumum of 21 numbers, I stoppoed there because Excel 2003 runs out of rows to recird the result. Sub thelottery() Count = 1 lastrow = Range("A65536").End(xlUp).Row Set myRange = Range("A1:A" & lastrow) For Each c In myRange numbers = numbers + 1 Next Dim n(20) For p = 1 To numbers n(p) = Cells(p, 1).Value Next For i = 1 To numbers For j = 1 To numbers If j <= i Then GoTo 100 For k = 1 To numbers If k <= j Then GoTo 200 For l = 1 To numbers If l <= k Then GoTo 300 For m = 1 To numbers If m <= l Then GoTo 400 For o = 1 To numbers If o <= m Then GoTo 500 For x = 1 To numbers If i = x Then firstno = n(x) Next For x = 1 To numbers If j = x Then secondno = n(x) Next For x = 1 To numbers If k = x Then thirdno = n(x) Next For x = 1 To numbers If l = x Then fourthno = n(x) Next For x = 1 To numbers If m = x Then fifthno = n(x) Next For x = 1 To numbers If o = x Then sixthno = n(x) Next Cells(Count, 2).Value = firstno Cells(Count, 3).Value = secondno Cells(Count, 4).Value = thirdno Cells(Count, 5).Value = fourthno Cells(Count, 6).Value = fifthno Cells(Count, 7).Value = sixthno Count = Count + 1 500 Next 400 Next 300 Next 200 Next 100 Next Next Cells(1, 8).Value = Count - 1 End Sub Mike "Dave" wrote: Hi, In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Permutations
Hi Toppers,
Thanks for that. Not sure I'll ever use the P bit D "Toppers" wrote: Code for Permutations & Combinations: Option Explicit Dim vAllItems As Variant Dim Buffer() As String Dim BufferPtr As Long Dim Results As Worksheet Sub ListPermutations() ' To use it, you put the letter C or P (for combinations or permutations) in ' a cell. The cell below that contains the number of items in a subset. The ' Cells below are a list of the items that make up the population. They could be ' numbers, letters and symbols, or words, etc. ' You select the top cell, or the entire range and run the sub. The subsets ' are written to a new sheet in the workbook. Dim rng As Range Dim PopSize As Integer Dim SetSize As Integer Dim Which As String Dim n As Double Const BufferSize As Long = 4096 Set rng = Selection.Columns(1).Cells If rng.Cells.Count = 1 Then Set rng = Range(rng, rng.End(xlDown)) End If PopSize = rng.Cells.Count - 2 If PopSize < 2 Then GoTo DataError SetSize = rng.Cells(2).Value If SetSize PopSize Then GoTo DataError Which = UCase$(rng.Cells(1).Value) Select Case Which Case "C" n = Application.WorksheetFunction.Combin(PopSize, SetSize) Case "P" n = Application.WorksheetFunction.Permut(PopSize, SetSize) Case Else GoTo DataError End Select If n Cells.Count Then GoTo DataError Application.ScreenUpdating = False Set Results = Worksheets.Add vAllItems = rng.Offset(2, 0).Resize(PopSize).Value ReDim Buffer(1 To BufferSize) As String BufferPtr = 0 If Which = "C" Then AddCombination PopSize, SetSize Else AddPermutation PopSize, SetSize End If vAllItems = 0 Application.ScreenUpdating = True Exit Sub DataError: If n = 0 Then Which = "Enter your data in a vertical range of at least 4 cells. " _ & String$(2, 10) _ & "Top cell must contain the letter C or P, 2nd cell is the number " _ & "of items in a subset, the cells below are the values from which " _ & "the subset is to be chosen." Else Which = "This requires " & Format$(n, "#,##0") & _ " cells, more than are available on the worksheet!" End If MsgBox Which, vbOKOnly, "DATA ERROR" Exit Sub End Sub Private Sub AddPermutation(Optional PopSize As Integer = 0, _ Optional SetSize As Integer = 0, _ Optional NextMember As Integer = 0) Static iPopSize As Integer Static iSetSize As Integer Static SetMembers() As Integer Static Used() As Integer Dim i As Integer If PopSize < 0 Then iPopSize = PopSize iSetSize = SetSize ReDim SetMembers(1 To iSetSize) As Integer ReDim Used(1 To iPopSize) As Integer NextMember = 1 End If For i = 1 To iPopSize If Used(i) = 0 Then SetMembers(NextMember) = i If NextMember < iSetSize Then Used(i) = True AddPermutation , , NextMember + 1 Used(i) = False Else SavePermutation SetMembers() End If End If Next i If NextMember = 1 Then SavePermutation SetMembers(), True Erase SetMembers Erase Used End If End Sub 'AddPermutation Private Sub AddCombination(Optional PopSize As Integer = 0, _ Optional SetSize As Integer = 0, _ Optional NextMember As Integer = 0, _ Optional NextItem As Integer = 0) Static iPopSize As Integer Static iSetSize As Integer Static SetMembers() As Integer Dim i As Integer If PopSize < 0 Then iPopSize = PopSize iSetSize = SetSize ReDim SetMembers(1 To iSetSize) As Integer NextMember = 1 NextItem = 1 End If For i = NextItem To iPopSize SetMembers(NextMember) = i If NextMember < iSetSize Then AddCombination , , NextMember + 1, i + 1 Else SavePermutation SetMembers() End If Next i If NextMember = 1 Then SavePermutation SetMembers(), True Erase SetMembers End If End Sub 'AddCombination Private Sub SavePermutation(ItemsChosen() As Integer, _ Optional FlushBuffer As Boolean = False) Dim i As Integer, sValue As String Static RowNum As Long, ColNum As Long If RowNum = 0 Then RowNum = 1 If ColNum = 0 Then ColNum = 1 If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then If BufferPtr 0 Then If (RowNum + BufferPtr - 1) Rows.Count Then RowNum = 1 ColNum = ColNum + 1 If ColNum 256 Then Exit Sub End If Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _ = Application.WorksheetFunction.Transpose(Buffer()) RowNum = RowNum + BufferPtr End If BufferPtr = 0 If FlushBuffer = True Then Erase Buffer RowNum = 0 ColNum = 0 Exit Sub Else ReDim Buffer(1 To UBound(Buffer)) End If End If 'construct the next set For i = 1 To UBound(ItemsChosen) sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1) Next i 'and save it in the buffer BufferPtr = BufferPtr + 1 Buffer(BufferPtr) = Mid$(sValue, 3) End Sub 'SavePermutation "Dave" wrote: Hi, In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
|
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Permutations
Hi Mike,
I like that, the limit of 21 numbers is plenty (we can't afford more than £54k a week!!) but could it do all the permutations? D "Mike H" wrote: Try this worksheet code. A couple of points. It uses whetver is in column A as the numbers to perm and the code include no validation. You should therefore set up some data validation to ensure unique positive numbers and no text. In it's current form it will perm a maxumum of 21 numbers, I stoppoed there because Excel 2003 runs out of rows to recird the result. Sub thelottery() Count = 1 lastrow = Range("A65536").End(xlUp).Row Set myRange = Range("A1:A" & lastrow) For Each c In myRange numbers = numbers + 1 Next Dim n(20) For p = 1 To numbers n(p) = Cells(p, 1).Value Next For i = 1 To numbers For j = 1 To numbers If j <= i Then GoTo 100 For k = 1 To numbers If k <= j Then GoTo 200 For l = 1 To numbers If l <= k Then GoTo 300 For m = 1 To numbers If m <= l Then GoTo 400 For o = 1 To numbers If o <= m Then GoTo 500 For x = 1 To numbers If i = x Then firstno = n(x) Next For x = 1 To numbers If j = x Then secondno = n(x) Next For x = 1 To numbers If k = x Then thirdno = n(x) Next For x = 1 To numbers If l = x Then fourthno = n(x) Next For x = 1 To numbers If m = x Then fifthno = n(x) Next For x = 1 To numbers If o = x Then sixthno = n(x) Next Cells(Count, 2).Value = firstno Cells(Count, 3).Value = secondno Cells(Count, 4).Value = thirdno Cells(Count, 5).Value = fourthno Cells(Count, 6).Value = fifthno Cells(Count, 7).Value = sixthno Count = Count + 1 500 Next 400 Next 300 Next 200 Next 100 Next Next Cells(1, 8).Value = Count - 1 End Sub Mike "Dave" wrote: Hi, In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
|
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Permutations
Hi,
Alter the array dimension to 49 and change this bit of code:- Dim n(49) Change these few lines of code. If Count 65536 Then Count = 1 colno = colno + 7 End If Cells(Count, colno + 2).Value = firstno Cells(Count, colno + 3).Value = secondno Cells(Count, colno + 4).Value = thirdno Cells(Count, colno + 5).Value = fourthno Cells(Count, colno + 6).Value = fifthno Cells(Count, colno + 7).Value = sixthno Count = Count + 1 Be prepared to be sat there for a long while if you ask it to start perming 6 from 49 because it's 14million combinations. Mike "Dave" wrote: Hi Mike, I like that, the limit of 21 numbers is plenty (we can't afford more than £54k a week!!) but could it do all the permutations? D "Mike H" wrote: Try this worksheet code. A couple of points. It uses whetver is in column A as the numbers to perm and the code include no validation. You should therefore set up some data validation to ensure unique positive numbers and no text. In it's current form it will perm a maxumum of 21 numbers, I stoppoed there because Excel 2003 runs out of rows to recird the result. Sub thelottery() Count = 1 lastrow = Range("A65536").End(xlUp).Row Set myRange = Range("A1:A" & lastrow) For Each c In myRange numbers = numbers + 1 Next Dim n(20) For p = 1 To numbers n(p) = Cells(p, 1).Value Next For i = 1 To numbers For j = 1 To numbers If j <= i Then GoTo 100 For k = 1 To numbers If k <= j Then GoTo 200 For l = 1 To numbers If l <= k Then GoTo 300 For m = 1 To numbers If m <= l Then GoTo 400 For o = 1 To numbers If o <= m Then GoTo 500 For x = 1 To numbers If i = x Then firstno = n(x) Next For x = 1 To numbers If j = x Then secondno = n(x) Next For x = 1 To numbers If k = x Then thirdno = n(x) Next For x = 1 To numbers If l = x Then fourthno = n(x) Next For x = 1 To numbers If m = x Then fifthno = n(x) Next For x = 1 To numbers If o = x Then sixthno = n(x) Next Cells(Count, 2).Value = firstno Cells(Count, 3).Value = secondno Cells(Count, 4).Value = thirdno Cells(Count, 5).Value = fourthno Cells(Count, 6).Value = fifthno Cells(Count, 7).Value = sixthno Count = Count + 1 500 Next 400 Next 300 Next 200 Next 100 Next Next Cells(1, 8).Value = Count - 1 End Sub Mike "Dave" wrote: Hi, In the UK lottery of 49 numbers 6 numbers makes a line. Our lottery syndicate would like to enter every possible combinattion of 9 numbers (or possibly 10). It's easy to work out that any 6 from 9 is 84 combinations ( 6 from 10 = 210) but it's much harder to work out what those combinations are. At least it is if you have to guarantee accuracy because potentially a lot of money rides on it. So, the question is if i enter the 9 numbers in Excel can it work out and list the 84 combinations? D |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Number permutations | New Users to Excel | |||
| Please help - Permutations of words | Excel Worksheet Functions | |||
| permutations | Excel Discussion (Misc queries) | |||
| Permutations | Excel Worksheet Functions | |||
| Permutations | Excel Worksheet Functions | |||
Linear Mode
