bhattar
asked on
Checking that a list of three numbers are a subset of six
I have a txt file which contains lines of six numbers e.g 1,2,3,4,5,6. I have another file which contains lines of 3 numbers e.g 1,2,3. I would like to open the file with 6 numbers in, read a line then open my other file with 3 numbers in then check to see if any of the 3 numbers are within the line of six. Once this has checked the first line of six then goto the next line of six within the file and perform the same check. Once I have checked all of the lines of 6 in the file with my line of three I would then like to goto the next line of 3 numbers and perform the same check on all of the lines of six numbers on so on until I have looped thru all of the lines of 3 numbers. I would like to be able to create a spreadsheet/file with the results e.g there are 5 lines with 1,2,3. 10 lines with 456 etc. In addition, I would also like to be able to check for four matches , five matchs etc. This is for checking lottery tickets. I have VBA and have just started to use it thus my knowledge is limited. Any help appreciated!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I'm assuming that you have multiple lottery tickets that you want to check against the result of the lottery.
For this you will have the following input into the program
A file of the lottery result (a csv file containing just 6 numbers) called "c:\Result.txt".
A file of tickets purchased (a csv file containing multiple lines 6 numbers) called "c:\Tickets.txt".
The program will generate a file called "c:\WiningTickets.txt" that contains details of the winning tickets.
You will need to include a reference in the project (from the menu Project/References) to the "Microsoft Scripting Runtime"library. This library contains some very useful tools for reading text files and creating dictionary (colleciton) objects.
Private Sub Command1_Click()
Dim fso As New Scripting.FileSystemObject
Dim colResults As New Scripting.Dictionary
Dim sResultLine As String
Dim sTicketLine As String
Dim sResultArray() As String
Dim sTicketNumbers() As String
Dim ResultFile As Scripting.TextStream
Set ResultFile = fso.OpenTextFile("c:\Resul
Dim WinningTicketsFile As Scripting.TextStream
sResultLine = ResultFile.ReadLine()
sResultArray = Split(sResultLine, ",")
Dim i As Long
'Add the six numbers in the resuilt to a dictionary object
For i = LBound(sResultArray) To UBound(sResultArray)
colResults.Add Trim(sResultArray(i)), sResultArray(i)
Next i
ResultFile.Close
Dim TicketsFile As Scripting.TextStream
Set TicketsFile = fso.OpenTextFile("c:\Ticke
'Create the winningTickets.txt text files
Set WinningTicketsFile = fso.CreateTextFile("c:\Win
Dim sMatching As String 'String to store the matching numbers
Dim iNumberCount As Long
With TicketsFile
While Not .AtEndOfStream
sTicketLine = .ReadLine()
sTicketNumbers = Split(sTicketLine, ",")
iNumberCount = 0 'Initialise
sMatching = "" 'Initialise
For i = LBound(sTicketNumbers) To UBound(sTicketNumbers)
If colResults.Exists(Trim(sTi
sMatching = sMatching & sTicketNumbers(i) & " "
iNumberCount = iNumberCount + 1
End If
Next i
If iNumberCount > 2 Then 'At least 3 matching numbers have been found
WinningTicketsFile.WriteLi
End If
Wend
.Close
End With
WinningTicketsFile.Close
End Sub
To try this program create a file called c:\Result.txt with the following line:
2,6,21,34,35,49
Then create a file called c:\Tickets.txt with the following lines:
1,2,3,4,5,6
1,6,13,21,25,49
2,6,21,34,35,49
10,15,23,30,35,49
3,6,21,34,40,41
1,21,34,35,40,42
1,2,6,21,34,40,45
When run the program will create the following output in the file c:\WinningNumbers.txt:
Ticket 1,6,13,21,25,49 has the 3 numbers 6 21 49 matching the winning ticket
Ticket 2,6,21,34,35,49 has the 6 numbers 2 6 21 34 35 49 matching the winning ticket
Ticket 3,6,21,34,40,41 has the 3 numbers 6 21 34 matching the winning ticket
Ticket 1,21,34,35,40,42 has the 3 numbers 21 34 35 matching the winning ticket
Ticket 1,2,6,21,34,40,45 has the 4 numbers 2 6 21 34 matching the winning ticket
For this you will have the following input into the program
A file of the lottery result (a csv file containing just 6 numbers) called "c:\Result.txt".
A file of tickets purchased (a csv file containing multiple lines 6 numbers) called "c:\Tickets.txt".
The program will generate a file called "c:\WiningTickets.txt" that contains details of the winning tickets.
You will need to include a reference in the project (from the menu Project/References) to the "Microsoft Scripting Runtime"library. This library contains some very useful tools for reading text files and creating dictionary (colleciton) objects.
Private Sub Command1_Click()
Dim fso As New Scripting.FileSystemObject
Dim colResults As New Scripting.Dictionary
Dim sResultLine As String
Dim sTicketLine As String
Dim sResultArray() As String
Dim sTicketNumbers() As String
Dim ResultFile As Scripting.TextStream
Set ResultFile = fso.OpenTextFile("c:\Resul
Dim WinningTicketsFile As Scripting.TextStream
sResultLine = ResultFile.ReadLine()
sResultArray = Split(sResultLine, ",")
Dim i As Long
'Add the six numbers in the resuilt to a dictionary object
For i = LBound(sResultArray) To UBound(sResultArray)
colResults.Add Trim(sResultArray(i)), sResultArray(i)
Next i
ResultFile.Close
Dim TicketsFile As Scripting.TextStream
Set TicketsFile = fso.OpenTextFile("c:\Ticke
'Create the winningTickets.txt text files
Set WinningTicketsFile = fso.CreateTextFile("c:\Win
Dim sMatching As String 'String to store the matching numbers
Dim iNumberCount As Long
With TicketsFile
While Not .AtEndOfStream
sTicketLine = .ReadLine()
sTicketNumbers = Split(sTicketLine, ",")
iNumberCount = 0 'Initialise
sMatching = "" 'Initialise
For i = LBound(sTicketNumbers) To UBound(sTicketNumbers)
If colResults.Exists(Trim(sTi
sMatching = sMatching & sTicketNumbers(i) & " "
iNumberCount = iNumberCount + 1
End If
Next i
If iNumberCount > 2 Then 'At least 3 matching numbers have been found
WinningTicketsFile.WriteLi
End If
Wend
.Close
End With
WinningTicketsFile.Close
End Sub
To try this program create a file called c:\Result.txt with the following line:
2,6,21,34,35,49
Then create a file called c:\Tickets.txt with the following lines:
1,2,3,4,5,6
1,6,13,21,25,49
2,6,21,34,35,49
10,15,23,30,35,49
3,6,21,34,40,41
1,21,34,35,40,42
1,2,6,21,34,40,45
When run the program will create the following output in the file c:\WinningNumbers.txt:
Ticket 1,6,13,21,25,49 has the 3 numbers 6 21 49 matching the winning ticket
Ticket 2,6,21,34,35,49 has the 6 numbers 2 6 21 34 35 49 matching the winning ticket
Ticket 3,6,21,34,40,41 has the 3 numbers 6 21 34 matching the winning ticket
Ticket 1,21,34,35,40,42 has the 3 numbers 21 34 35 matching the winning ticket
Ticket 1,2,6,21,34,40,45 has the 4 numbers 2 6 21 34 matching the winning ticket
ASKER
I have Office 97 and cannot seem to run any of these programs. Do I need to upgrade?
Regards..
Regards..
ASKER
Upgraded to Office XP and all works great. Thanks for everyones input much appreciated.
To set this up:
Create a new Visual Basic project and save it to a folder containing the following text files:
3Numbers.txt:
¯¯¯¯¯¯¯¯¯¯¯
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
6Numbers.txt:
¯¯¯¯¯¯¯¯¯¯¯
1,2,3,4,5,6
7,8,9,0,1,2
3,4,5,6,7,8
9,10,11,12,13,14
15,16,17,18,19,20
Now, on Form1 in the project, create three command buttons and a text box (position/size doesn't matter). Set the Text Box's MultiLine property to "True", and set its ScrollBars property to "2 - Vertical". Then click View > Code and paste the following:
Private Const Num_LBound = 0
Private Const Num_UBound = 20
Dim Numbers() As Long
Dim SixNumbers() As Collection
Private Sub ParseNumbers(NumberString As String, NumberCollection As Collection)
Dim strRemainder As String
strRemainder = NumberString
Do While InStr(1, strRemainder, ",") <> 0
NumberCollection.Add Mid(strRemainder, 1, InStr(1, strRemainder, ",") - 1)
strRemainder = Mid(strRemainder, InStr(1, strRemainder, ",") + 1)
Loop
NumberCollection.Add strRemainder
End Sub
Private Sub Command1_Click()
Dim FileNo As Integer
Dim strTemp As String
Dim ParsedNumbers As Collection
Text1.Text = ""
ReDim Numbers(Num_LBound To Num_UBound, Num_LBound To Num_UBound, Num_LBound To Num_UBound)
FileNo = FreeFile
Open App.Path & "\3Numbers.txt" For Input As #FileNo
Do While Not EOF(1)
Line Input #FileNo, strTemp
If Len(strTemp) <> 0 Then
Set ParsedNumbers = Nothing
Set ParsedNumbers = New Collection
ParseNumbers strTemp, ParsedNumbers
Numbers(ParsedNumbers.Item
End If
Loop
Close #FileNo
Text1.Text = "Done."
End Sub
Private Sub Command2_Click()
Dim Dim1 As Long
Dim Dim2 As Long
Dim Dim3 As Long
Text1.Text = ""
For Dim1 = Num_LBound To Num_UBound
For Dim2 = Num_LBound To Num_UBound
For Dim3 = Num_LBound To Num_UBound
If Numbers(Dim1, Dim2, Dim3) <> 0 Then
Text1.Text = Text1.Text & Dim1 & "," & Dim2 & "," & Dim3 & " -- " & Numbers(Dim1, Dim2, Dim3) & vbNewLine
End If
Next Dim3
Next Dim2
Next Dim1
End Sub
Private Sub Command3_Click()
Dim FileNo As Integer
Dim strTemp As String
Dim ParsedNumbers As Collection
Dim Dim1 As Long
Dim Dim2 As Long
Dim Dim3 As Long
Dim lngElement As Variant
Dim lngMatches As Long
Text1.Text = ""
FileNo = FreeFile
Open App.Path & "\6Numbers.txt" For Input As #FileNo
Do While Not EOF(1)
Line Input #FileNo, strTemp
If Len(strTemp) <> 0 Then
Set ParsedNumbers = Nothing
Set ParsedNumbers = New Collection
ParseNumbers strTemp, ParsedNumbers
For Dim1 = Num_LBound To Num_UBound
For Dim2 = Num_LBound To Num_UBound
For Dim3 = Num_LBound To Num_UBound
If Numbers(Dim1, Dim2, Dim3) <> 0 Then
lngMatches = 0
For Each lngElement In ParsedNumbers
If Dim1 = CLng(lngElement) Then lngMatches = lngMatches + 1
If Dim2 = CLng(lngElement) Then lngMatches = lngMatches + 1
If Dim3 = CLng(lngElement) Then lngMatches = lngMatches + 1
Next
If lngMatches <> 0 Then
Text1.Text = Text1.Text & "("
For Each lngElement In ParsedNumbers
Text1.Text = Text1.Text & lngElement & ","
Next
Text1.Text = Left$(Text1.Text, Len(Text1.Text) - 1)
Text1.Text = Text1.Text & ") -- " & lngMatches & " matches: " & "(" & Dim1 & "," & Dim2 & "," & Dim3 & ")" & vbNewLine
End If
End If
Next Dim3
Next Dim2
Next Dim1
End If
Loop
Close #FileNo
End Sub
Private Sub Form_Load()
Me.Width = 7620
Me.Height = 7905
Command1.Caption = "Load Data"
Command1.Top = 240
Command1.Left = 240
Command1.Width = 1575
Command1.Height = 615
Command2.Caption = "Count 3 Variants"
Command2.Top = 1080
Command2.Left = 240
Command2.Width = 1575
Command2.Height = 615
Command3.Caption = "Count 6 Matches"
Command3.Top = 1920
Command3.Left = 240
Command3.Width = 1575
Command3.Height = 615
Text1.Text = ""
Text1.Top = 120
Text1.Left = 2040
Text1.Width = 5295
Text1.Height = 7215
End Sub
Run the program, see if the output is desirable, I may have misinterpretted your question. I am not familiar with how to dynamically create spreadsheets, so I'm not really of much help there, the program's output is just generic text.