求助关于VB算法问题
您好!编程工具:VB6.0
操作系统: WINXP
问题: 我最近在学VB,写了个简单的足彩过滤程序. 其运行速度非常慢.整个过程运行完估计需要10天左右. 想请您帮手看一下是否有更好的算法.谢谢!
需要用到的待过滤的数据为文本文件格式, 每行14个数据. 下面是部分示列:
0 0 0 0 0 0 3 1 1 3 3 3 3 3
0 0 0 0 1 3 1 0 3 3 3 0 3 3
0 0 0 0 1 3 1 0 3 3 3 3 3 3
0 0 0 0 1 3 3 0 0 3 3 3 3 1
0 0 0 0 1 3 3 0 1 3 3 3 1 3
通常该数据量为450万行.
过滤后的数据按同样的格式保存.
参考的数据格式也是同样的.数据量通常在20万行左右.
过滤的规则保存在FILENAMERULE中,下面是个例子:
2 2 '总体要满足两个规则(2-2).
14 14 0 5 '相同14个数(14~14)的数据量为0~5
13 13 2 10 '相同13个数(13~13)的数据量为2~10.
该规则可根据需要进行增减,调整.
程序目前的运行过程及功能为:
先从待过滤的文件中读取一行,即14个数据. 该14个数据与参考的数据文件中的各行数据逐个进行比较,得到两行数据按1到14相同的个数. 参考数据文件中有N行数据,则计算出N个相同个数.然后计算这N个相同个数中,在14与14之间的有多少个,在13与13之间的有多少个. 如果在14与14之间的有0~5个,则满足一个规则,如果在13与13之间的有2~10个,则满足2个规则.若总体满足2~2个规则,则该待过滤数据视为满足条件,否则视为不满足条件. 将满足条件的数据保存,不满足条件的不保存.
下面是我的代码. 敬请指教!
Private Sub Command2_Click()
'Function is same as another one
'Start sorting
'varible definition
Dim FileNameSort, FileNameSave, FileRule, FileSingle As String
Dim KKK As Long
Dim AllQty, PassQty, SingleQty As Long
Dim InData(1 To 14) As Long
Dim MatchLow, MatchUp, MatchQty, RightQty As Long
Dim SiteLow(1 To 255), SiteUp(1 To 255), RuleQty As Long
Dim ActualMatch As Long
Dim VoteLow(1 To 255) As Long, VoteUp(1 To 255) As Long, EachMatch(1 To 255) As Long
Dim PassRate As Single
Dim EachSingle(1 To 800000, 1 To 14) As Long
Dim III As Long
Dim MaxWrongQty As Long, WrongQty As Long, MinWrongQty As Long
'Start sorting
Msg = MsgBox("The FileName is right?", 33, "Confirmation")
If Msg = 2 Then Exit Sub
If Text1.Text = "" Or Text11.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
Msg = MsgBox("Please input file name", 48, "Note")
Exit Sub
Else
End If
Msg = MsgBox("Are you sure go ahead?", 33, "Confirmation")
If Msg = 2 Then Exit Sub
If Right(Text11.Text, 3) = "TXT" Or Right(Text11.Text, 3) = "txt" Then
FileNameSave = Text11.Text
Else
FileNameSave = Text11.Text + ".TXT"
End If
If Right(Text1.Text, 3) = "TXT" Or Right(Text1.Text, 3) = "txt" Then
FileNameSort = Text1.Text
Else
FileNameaort = Text1.Text + ".TXT"
End If
If Right(Text2.Text, 3) = "TXT" Or Right(Text2.Text, 3) = "txt" Then
FileRule = Text2.Text
Else
FileRule = Text2.Text + ".TXT"
End If
If Right(Text3.Text, 3) = "TXT" Or Right(Text3.Text, 3) = "txt" Then
FileSingle = Text3.Text
Else
FileSingle = Text3.Text + ".TXT"
End If
AllQty = 0
PassQty = 0
If Right(mydir.Path, 1) <> "\" Then
FileNameSort = mydir.Path & "\" & FileNameSort
FileNameSave = mydir.Path & "\" & FileNameSave
FileRule = mydir.Path & "\" & FileRule
FileSingle = mydir.Path & "\" & FileSingle
Else
FileNameSort = mydir.Path & FileNameSort
FileNameSave = mydir.Path & FileNameSave
FileRule = mydir.Path & FileRule
FileSingle = mydir.Path & FileSingle
End If
'=================================================================
'Single file loading
SingleQty = 0
Open FileSingle For Input As #1
Do While Not EOF(1)
SingleQty = SingleQty + 1
For AA = 1 To 14
Input #1, EachSingle(SingleQty, AA)
Next 'AA
Loop
Close #1
Text8.Text = Str(SingleQty)
Text8.Refresh
'End single file loading
'======================================================================
'start rule loading
RuleQty = 0
MinWrongQty = 14
MaxWrongQty = 0
Open FileRule For Input As #2
Input #2, KKK
MatchLow = KKK
Input #2, KKK
MatchUp = KKK
Do While Not EOF(2)
RuleQty = RuleQty + 1
Input #2, KKK
SiteLow(RuleQty) = KKK
Input #2, KKK
SiteUp(RuleQty) = KKK
Input #2, KKK
VoteLow(RuleQty) = KKK
Input #2, KKK
VoteUp(RuleQty) = KKK
Loop
Close #2
Text8.Text = Text8.Text + " : " + Str(RuleQty)
Text8.Refresh
'End rule loading
'=======================================================================
'Strat sorting
Open FileNameSort For Input As #3
Open FileNameSave For Output As #4
Do While Not EOF(3)
AllQty = AllQty + 1
For AA = 1 To 14
Input #3, InData(AA)
Next 'AA
For III = 1 To RuleQty
EachMatch(III) = 0
Next 'III
MatchQty = 0
For KKK = 1 To SingleQty
'WrongQty = 0
RightQty = 0
For AA = 1 To 14
If EachSingle(KKK, AA) = InData(AA) Then RightQty = RightQty + 1
Next 'AA
For III = 1 To RuleQty
If RightQty <= SiteUp(III) And RightQty >= SiteLow(III) Then EachMatch(III) = EachMatch(III) + 1
Next 'III
Next 'KKK
For III = 1 To RuleQty
If EachMatch(III) <= VoteUp(III) And EachMatch(III) >= VoteLow(III) Then MatchQty = MatchQty + 1
Next 'III
If MatchQty <= MatchUp And MatchQty >= MatchLow Then
PassQty = PassQty + 1
For AA = 1 To 14
Print #4, InData(AA);
Next 'AA
Print #4,
Text7.Text = Str(PassQty)
Text7.Refresh
Text25.Text = Str(AllQty)
Text25.Refresh
End If
Loop
Close
Text8.Text = Text8.Text + " : " + Str(MatchQty)
Text8.Refresh
Text25.Text = "Finished."
Text25.Refresh
PassRate = PassQty / AllQty
Text7.Text = Str(AllQty) + " : " + Str(PassQty) + " : " + Str(Int(PassRate * 10000) / 100) + "%"
Text7.Refresh
File.Refresh
End Sub
