Grouping Companion Pairs, Triads, Quads and Quints

J

jack

Member
I need to find a way to group test results together. The best way to explain what I need is to use the lottery as an example.
Each drawing date six numbers are chosen. I want to know how many times unique pairs (2 numbers), triads (3 numbers), quads (4 numbers), quints (5 numbers) have occurred.

9/12/2001 16-24-30-31-36-49
9/15/2001 7-16-17-28-43-45
9/19/2001 8-12-13-31-42-46
9/22/2001 19-28-31-41-44-47
9/26/2001 1-2-11-14-42-44
9/29/2001 2-24-27-38-40-41
10/3/2001 6-14-28-37-39-48
10/6/2001 5-17-20-34-41-47
10/10/2001 6-10-11-29-34-49
10/13/2001 7-11-12-28-45-46
10/17/2001 5-9-13-14-15-22
10/20/2001 16-18-19-38-41-49
10/24/2001 3-4-12-16-20-23
10/27/2001 3-8-11-17-27-28
10/31/2001 2-5-15-19-41-43
11/3/2001 7-10-35-37-42-45
11/7/2001 7-14-19-20-24-45
11/10/2001 1-7-35-40-43-46
11/14/2001 7-10-15-22-23-36
11/17/2001 13-20-28-34-35-46
11/21/2001 6-26-28-31-34-46
11/24/2001 3-13-14-29-37-45
11/28/2001 22-23-27-31-42-44
12/1/2001 5-6-9-19-32-47
12/5/2001 11-20-26-30-34-36
12/8/2001 5-18-27-30-34-45
12/12/2001 2-14-23-32-40-45
12/15/2001 4-7-13-27-37-49
12/19/2001 2-5-27-40-46-49
12/22/2001 1-19-31-35-36-41

Results Needed:


HITS COMPANION PAIRS
4......07-45, 19-41
3......02-40, 14-45, 20-34, 28-46
2......01-35, 02-05, 02-14, 02-27, 02-41, 05-09, 05-15, 05-19, 05-27,
05-34, 05-41, 05-47, 06-28, 06-34, 07-10, 07-28, 07-35, 07-37,
07-43, 07-46, 11-28, 11-34, 12-46, 13-14, 13-37, 13-46, 14-37,
15-22, 16-49, 17-28, 19-31, 19-47, 22-23, 26-34, 27-40, 27-49,
28-31, 28-34, 28-45, 30-34, 30-36, 31-36, 31-41, 31-42, 31-44,
31-46, 34-46, 35-46, 37-45,

HITS COMPANION TRIADS
2......02-27-40, 07-28-45, 19-31-41, 28-34-46
 
J

jack

Member
also 60/6
you can do, please !!! the lottery 60/6 all the same so have change
* For 60/6 (mega sena) macro in a planilia then I'm updating the sweepstakes
17 19 33 35 39 52
03 23 26 35 39 49
01 07 11 32 51 59
25 27 29 37 50 51
31 34 36 48 12 56
16 20 27 36 07 52
29 32 38 45 17 50
19 30 35 42 07 47
07 21 28 56 58 59
26 38 39 45 22 50
12 19 29 50 02 59
10 16 23 27 03 29
02 08 24 36 51 52
20 35 40 53 16 60
25 36 41 42 02 53
02 09 16 37 44 58
30 31 32 47 04 53
22 31 34 44 01 54
18 23 31 39 49 57
12 19 33 36 04 38
09 23 39 41 49 58
27 30 46 52 14 60
27 33 37 39 58 60
18 26 30 31 16 34
10 42 49 54 03 57
 
Frank

Frank

Member
Are you saying then that this thread, in which GillesD gives a macro for a 6/49 lottery for pairs, triples and quads is not suitable ? (For 6/49).

http://www.lottoforums.com/lottery/lotto-tips-strategies/11094-help-please-quads-triples-pairs.html

If you are not using a full set of lottery results, but just a selection of lines of 6 you need to remove the actual draw numbers and just number the draws 1 up to whatever the total number of draws is.

I did modify the macro for 5 ball games, but not for 6/60.
 
J

jack

Member
Hello I got frank voce tem fazer for 60/6 Six Posições, see pairs, lashings that ELAS mais pois saem voltam to sair, exemplo this lashing 06,15,28, ela tem 6 different digits
0,2,5,6,8,1 não há repetição digits inside da lashing and então padrão E 80%, filter podermos not sorteio I tied up passado 3 numbers
 
J

jack

Member
Hello frank sim é um or language problem or google, and palavras mistura E truck or truck do conteúdo sense. More or target = é see lashings and nas suas Posições and soma pairs because assim and odd and lashing ou uma 49/6 60/6 fica mais ou par ter um easy reference lashing fixar
 
Frank

Frank

Member
Well you said something about position and something about them being odd. That's another topic, you asked about ntuplets from a set of 6 numbers, you can't have everything at the same time. One thing or the other. Ntuplets can be done, but all singing all dancing and everything at the same time, not for me.
 
J

jack

Member
'=== copy from here =================================
'- MACRO TO COUNT PAIRS OF NUMBERS.
'- Numbers contained in a sheet called "Sheet1" ...
'- Columns B to G starting row 2.
'- Needs another blank sheet called "Results"
'- Brian Baulsom August 2004
'====================================================
'-
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim Fromrow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim Counter As Long
Dim FoundCell As Object
'-
Dim N1 As Integer
Dim N2 As Integer
Dim N1a As Integer
Dim N2a As Integer
'-
Dim CheckStr1 As String
Dim CheckStr2 As String
'------------------------
Sub COUNT_2NUMBER_SETS()
Set FromSheet = Worksheets("Sheet1")
LastRow = FromSheet.Range("A65536").End(xlUp).Row
Set ToSheet = Worksheets("Results")
ToSheet.Range("A:B").ClearContents
Fromrow = 2
ToRow = 1
'-----------------------
'- main loop
'-----------------------
For Fromrow = 2 To LastRow
Application.StatusBar = _
" Processing row : " & Fromrow & " / " & LastRow
For a = 2 To 7
N1 = FromSheet.Cells(Fromrow, a).Value
For b = a + 1 To 7
N2 = FromSheet.Cells(Fromrow, b).Value
'-
CheckStr1 = Format(N1, "00") & " - " & Format(N2, "00")
CheckOtherRows
If Counter > 1 Then
ToSheet.Cells(ToRow, 1).Value = "'" & CheckStr1
ToSheet.Cells(ToRow, 2).Value = Counter
ToRow = ToRow + 1
End If
Next
Next
Next
'-- sort results
ToSheet.UsedRange.Sort Key1:=Range("B1"), Key2:=Range("A1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
MsgBox ("Done.")
Application.StatusBar = False
End Sub
'-----------------------------------------------------------------
Sub CheckOtherRows()
'- check previous results for duplicate set
Set FoundCell = ToSheet.Columns(1).Find(what:=CheckStr1, lookat:=xlPart)
'- Not found - then look for matches in following rows
If FoundCell Is Nothing Then
Counter = 1
For rw = Fromrow + 1 To LastRow
For x = 2 To 7
N1a = FromSheet.Cells(rw, x).Value
For y = x + 1 To 7
N2a = FromSheet.Cells(rw, y).Value
CheckStr2 = Format(N1a, "00") & " - " & Format(N2a, "00")
'- match found - increment counter
If CheckStr1 = CheckStr2 Then
Counter = Counter + 1
End If
Next
Next
Next
End If
End Sub
'=== copy to here ====================
 
J

jack

Member
Code:
A B C D
1 10 15 9
2 29 34 6
3 10 15 31 8
4 18 48 50 2
and this is how I want it to look like
Code:
A B C D
1 10 15 9 10 15 31 8
2 29 34 6 18 48 50 2
3
4
Code:
Sub Sort1()
ToSheet.UsedRange.Sort Key1:=Range("B1"), Key2:=Range("A1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Sub Sort2()
ToSheet.UsedRange.Sort Key1:=Range("D1"), Key2:=Range("C1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Sub Sort3()
ToSheet.UsedRange.Sort Key1:=Range("F1"), Key2:=Range("E1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Sub Sort4()
ToSheet.UsedRange.Sort Key1:=Range("H1"), Key2:=Range("G1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub
Code:
'=== copy from here ================================='- MACRO TO COUNT PAIRS OF NUMBERS.
'- Numbers contained in a sheet called "Sheet1" ...
'- Columns B to G starting row 2.
'- Needs another blank sheet called "Results"
'- Brian Baulsom August 2004
'====================================================
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim Fromrow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim Counter As Long
Dim FoundCell As Object
'-
Dim N1 As Integer
Dim N2 As Integer
Dim N3 As Integer
Dim N4 As Integer
Dim N5 As Integer


Dim N1a As Integer
Dim N2a As Integer
Dim N3a As Integer
Dim N4a As Integer
Dim N5a As Integer


'-
Dim CheckStr1 As String
Dim CheckStr2 As String
Dim CheckStr3 As String
Dim CheckStr4 As String
Dim CheckStr5 As String
Dim CheckStr6 As String
Dim CheckStr7 As String
Dim CheckStr8 As String
Dim CheckStr9 As String
Dim CheckStr10 As String
Dim CheckStr11 As String
'------------------------
Sub CheckPairs_Click()
Set FromSheet = Worksheets("Sheet1")
LastRow = FromSheet.Range("A65536").End(xlUp).Row


Set ToSheet = Worksheets("Results2")
LRow = Range("A65536").End(xlUp).Row
ToSheet.Range("A:F").ClearContents
Fromrow = 2
ToRow = 1
'-----------------------
'- main loop
'-----------------------
' Dla Rzedow od
For Fromrow = 1 To LastRow


Application.StatusBar = _
" Processing row : " & Fromrow & " / " & LastRow
For a = 2 To 6
N1 = FromSheet.Cells(Fromrow, a).Value
For B = a + 1 To 6
N2 = FromSheet.Cells(Fromrow, B).Value

'- Sprawdz ciag z kratek

CheckStr1 = Format(N1, "00") & " - " & Format(N2, "00")
Counter = 1

CheckOtherRows2

If Counter > 1 Then
ToSheet.Cells(ToRow, 1).Value = "'" & CheckStr1
ToSheet.Cells(ToRow, 2).Value = Counter
ToRow = ToRow + 1
End If
Next

For B = a + 1 To 6
N2 = FromSheet.Cells(Fromrow, B).Value
For c = B + 1 To 6
N3 = FromSheet.Cells(Fromrow, c).Value

'- Sprawdz ciag z kratek

CheckStr3 = Format(N1, "00") & " - " & Format(N2, "00") & " - " & Format(N3, "00")
Counter = 1

CheckOtherRows3

If Counter > 1 Then
ToSheet.Cells(ToRow, 3).Value = "'" & CheckStr3
ToSheet.Cells(ToRow, 4).Value = Counter
ToRow = ToRow + 1
End If
Next

For c = B + 1 To 6
N3 = FromSheet.Cells(Fromrow, c).Value
For d = c + 1 To 6
N4 = FromSheet.Cells(Fromrow, d).Value

'- Sprawdz ciag z kratek

CheckStr5 = Format(N1, "00") & " - " & Format(N2, "00") & " - " & Format(N3, "00") & " - " & Format(N4, "00")
Counter = 1

CheckOtherRows4

If Counter > 1 Then
ToSheet.Cells(ToRow, 5).Value = "'" & CheckStr5
ToSheet.Cells(ToRow, 6).Value = Counter
ToRow = ToRow + 1
End If
Next

For d = c + 1 To 6
N4 = FromSheet.Cells(Fromrow, d).Value
For e = d + 1 To 6
N5 = FromSheet.Cells(Fromrow, e).Value

'- Sprawdz ciag z kratek

CheckStr7 = Format(N1, "00") & " - " & Format(N2, "00") & " - " & Format(N3, "00") & " - " & Format(N4, "00") & " - " & Format(N5, "00")
Counter = 1

CheckOtherRows5

If Counter > 1 Then
ToSheet.Cells(ToRow, 7).Value = "'" & CheckStr7
ToSheet.Cells(ToRow, 8).Value = Counter
ToRow = ToRow + 1
End If
Next


Next
Next
Next

Next
Next
'-- sort results
Sort1
Sort2
Sort3
Sort4
MsgBox ("Done.")
Application.StatusBar = False
End Sub
'-----------------------------------------------------------------
Sub CheckOtherRows2()
'- check previous results for duplicate set
Set FoundCell = ToSheet.Columns(1).Find(what:=CheckStr1, lookat:=xlPart)
'- Not found - then look for matches in following rows
If FoundCell Is Nothing Then
Counter = 1

For rw = Fromrow + 1 To LastRow

For x = 2 To 6
N1a = FromSheet.Cells(rw, x).Value
For y = x + 1 To 6
N2a = FromSheet.Cells(rw, y).Value

CheckStr2 = Format(N1a, "00") & " - " & Format(N2a, "00")

'- match found - increment counter
If CheckStr1 = CheckStr2 Then
Counter = Counter + 1
End If
Next
Next
Next
End If
End Sub
'=== copy to here =================================================
 
J

jack

Member
'-----------------------------------------------------------------
Sub CheckOtherRows3()
'- check previous results for duplicate set
Set FoundCell = ToSheet.Columns(1).Find(what:=CheckStr3, lookat:=xlPart)

'- Not found - then look for matches in following rows

If FoundCell Is Nothing Then
Counter = 1

For rw = Fromrow + 1 To LastRow

For x = 2 To 6
N1a = FromSheet.Cells(rw, x).Value
For y = x + 1 To 6
N2a = FromSheet.Cells(rw, y).Value
For Z = y + 1 To 6
N3a = FromSheet.Cells(rw, Z).Value

CheckStr4 = Format(N1a, "00") & " - " & Format(N2a, "00") & " - " & Format(N3a, "00")

'- match found - increment counter
If CheckStr3 = CheckStr4 Then
Counter = Counter + 1
End If
Next
Next
Next
Next
End If
End Sub
'=== copy to here =================================================




Sub CheckOtherRows4()
'- check previous results for duplicate set
Set FoundCell = ToSheet.Columns(1).Find(what:=CheckStr5, lookat:=xlPart)

'- Not found - then look for matches in following rows

If FoundCell Is Nothing Then
Counter = 1

For rw = Fromrow + 1 To LastRow

For x = 2 To 6
N1a = FromSheet.Cells(rw, x).Value
For y = x + 1 To 6
N2a = FromSheet.Cells(rw, y).Value
For Z = y + 1 To 6
N3a = FromSheet.Cells(rw, Z).Value
For S = Z + 1 To 6
N4a = FromSheet.Cells(rw, S).Value

CheckStr6 = Format(N1a, "00") & " - " & Format(N2a, "00") & " - " & Format(N3a, "00") & " - " & Format(N4a, "00")

'- match found - increment counter
If CheckStr5 = CheckStr6 Then
Counter = Counter + 1
End If
Next
Next
Next
Next
Next
End If
End Sub


'=== copy to here =================================================
Sub CheckOtherRows5()
'- check previous results for duplicate set
Set FoundCell = ToSheet.Columns(1).Find(what:=CheckStr7, lookat:=xlPart)

'- Not found - then look for matches in following rows

If FoundCell Is Nothing Then
Counter = 1

For rw = Fromrow + 1 To LastRow

For x = 2 To 6
N1a = FromSheet.Cells(rw, x).Value
For y = x + 1 To 6
N2a = FromSheet.Cells(rw, y).Value
For Z = y + 1 To 6
N3a = FromSheet.Cells(rw, Z).Value
For S = Z + 1 To 6
N4a = FromSheet.Cells(rw, S).Value
For q = S + 1 To 6
N5a = FromSheet.Cells(rw, q).Value

CheckStr8 = Format(N1a, "00") & " - " & Format(N2a, "00") & " - " & Format(N3a, "00") & " - " & Format(N4a, "00") & " - " & Format(N5a, "00")

'- match found - increment counter
If CheckStr7 = CheckStr8 Then
Counter = Counter + 1
End If
Next
Next
Next
Next
Next
Next
End If
End Sub
'=== copy to here =================================================


Sub Sort1()
ToSheet.UsedRange.Sort Key1:=Range("B1"), Key2:=Range("A1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Sub Sort2()
ToSheet.UsedRange.Sort Key1:=Range("D1"), Key2:=Range("C1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Sub Sort3()
ToSheet.UsedRange.Sort Key1:=Range("F1"), Key2:=Range("E1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Sub Sort4()
ToSheet.UsedRange.Sort Key1:=Range("H1"), Key2:=Range("G1"), Order1:=xlDescending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
 
J

jack

Member
hello frank, consegue, place numa planilia
*and expos or link gives 60/6? please
As a bonus - Here is some code to find the matching pairs: -
Code:
'========================
'FIND SETS OF NUMBERS
'========================
Sub find_combinations ()
****Dim ws As Worksheet
****As String Dim MyStr
****Dim n1 As Integer
****As Integer Dim n2
****As Long Dim lastrow
****As Long Dim counter
****'=================================
****MyStr = "06-26"
****'=================================
****September ws = Worksheets ("numbersets")
****n1 = Left (MyStr, 2)
****n2 = Right (MyStr, 2)
****lastrow = ws.Range ("A65536"). End (xlUp) .Row
****ws.UsedRange.Cells.Interior.ColorIndex = xlNone
****counter = 0
****'- LOOP 1
****For r = 1 To lastrow
********Application.StatusBar = "Row" & r & "/" & lastrow
********For c1 = 2 to 7
************If Cells (r, c1) .Value Then n1 =
****************'- LOOP 2
****************For c2 = c1 + 1 to 7
********************If Cells (r, c2) .Value Then n2 =
************************Cells (r, c1) .Interior.ColorIndex = 6
************************Cells (r, c2) = 6 .Interior.ColorIndex
************************counter = counter + 1
********************End If
****************Next
************End If
********Next
****Next
****rsp = MsgBox ("Count =" & counter, vbOKOnly, MyStr)
End Sub
'=================================================
 
Frank

Frank

Member
Why have you posted this? I'm working on GillesD's version. I'm familiar with that. I don't intend to get involved with the code you posted. Sorry.
 
J

jack

Member
Hello. FRANK Goal is to help find the best way, you can continue what Giles did a good job
** It seems that so splitting into pairs and trios quatertos is most interesting prediction
You can continuaro serviçao giles please ok
 
Frank

Frank

Member
OK, Jack this particular lottery 6/60 is a huge lottery with nearly half a million possible quads. It challenges GillesD's method when the number of lines of 6 ball results in Data is over 3000. Since the method examines all possible quads and writes them all to the sheet even when there may only be a few results on the data sheet it still takes several seconds to do the quads, returning most with a count of nil.
Note that because of this, earlier versions of Excel (2003 and earlier) will not work because they only support 65536 rows.

I have built in an autofilter which fiters out all quads with a count of nil.
With higher numbers of line of results data this run time could run into minutes depending on your PC. The quins are easier and there are less of them which allowed GillesD to use a shorcut which allowed only the existing quins to be determined , sorted and counted quickly. It took me longer to debug and test for this lottery for various reasons.
If this is used as a secondary tool to check on a shortlist of lines of 6 then this will do the trick quickly.

Each separate macro can be run individually if you just want pairs for example, but there is a 'run all' button.

http://www.mediafire.com/view/h9bbuhgbo37h608/GillesD_Ntups_six_ball_60s.xlsm.

That completes the answer to your question Jack, I do not propose to do further customisations on this, juggle with digits, juggle with positions, this is it, finished. :)


 
J

jack

Member
Hello, ok FRANK, perfect, very good work, congratulation, when you win ganhr any prize will be rewarded. Ok but split into 30 pairs and 30 odd numbers in 30 numbers we have pairs = 435, 4060 = 27,405 blocks cracks and then half a million
Go to 27 thousand, of course we work to put in their 6 positions. Frank purpose is to filter peer and cracks from previous draws, find patterns for couples from 75% to 80% is already good, thank you frank
I must separate the enemy to weaken ie separate into pairs and cracks to better attack the positions
* example double = 02 36 what is the best probability of position?
would be 1st 3rd or 4th position just peers. the dual 2.6
 
Frank

Frank

Member
For your lottery the probability of any pair appearing ANYWHERE in sorted order is 0.008475 or 0.85%. You should note that positions of balls are either AS DRAWN or AFTER SORTING. Probability as drawn order would half of that or 0.00423 or 0.42%.
You should note that the probability of specific named pairs appearing in named positions in sorted order is different for each pair. Example 01,02,03,04,05,06 . The probability of pair 01,02 appearing in positions 5 and 6 after sorting is NIL, whilst the probability of pair 01,02 appearing in positions 1 and 2 after sorting is 100%. So the probability in total of pair 1 and 2 appearing at all, AND in positions 1 and 2 after sorting is 0.85% x 100% , so its still 0.85%.
However, for any 6 ball result the probability of 02 appearing in 1st position and 26 appearing in 4th position after sorting is a more complex calculation after which you would multiply by 0.85% end end up with a very small percentage not worth bothering with. The whole thing is pointless and a waste of time in my opinion.
AND IT IS OFF TOPIC AGAIN.

Jack said:-
I need to find a way to group test results together. The best way to explain what I need is to use the lottery as an example.
Each drawing date six numbers are chosen. I want to know how many times unique pairs (2 numbers), triads (3 numbers), quads (4 numbers), quints (5 numbers) have occurred.



Like I already told you, your question is answered and I am not discussing number juggling!
 
Frank

Frank

Member
Just as a final gift for you Jack before I leave this thread is a spreadsheet that will prove to you how tiny the probabilities are for two named balls to appear in two named columns as a pair (when sorted) for your 6/60 lottery. Most of them are once in ten year events some of them are once in a lifetime events.

Hopefully the instructions will be clear enough. Impossible combinations of positions should be blacked out, out of range ball numbers (too low) will just go #VALUE!

To answer your question re 2 and 36 the best probability is 0.00068 in cols A and B = 02,06,X,X,X,X. about 7 times in 10,000 draws.

http://www.mediafire.com/view/t6ccyfjpt159zeb/pair_probabilities_in_columns_for_6-60.xls
 
J

jack

Member
Hello,FRANK perfect hard work, congratulations. frank when I win a big prize will have 20% too, will be rewarded Goal = is to find the digit, double and crack to fix, always keep the same course that your job is to draws in ascending order, when in order to draw Still number 60 may be in 1st place, when by lot changes probalidades. Goal is to find a weak spot, dividing the enemy (the 50 million of possibildade) To weaken. The attack in the double digits and cracks, even and odd positions in the columns, the delay by neighboring column have not seen this study draw in ascending order
Example the number 15 late in the 2nd position with 23
 
You must log in or register to reply here.

Sidebar

Top