足球胜负十四场算法

        从买胜负彩开始就想自己写一个程序来过滤垃圾注，4月来深圳以来，一直忙与工作的事，根本没有闲情去写算法，最近总算闲了下来，于是利用昨天和今天，按自己的过滤思想写了个过滤算法，请有丰富过滤经验的高手不要笑话，去年和我一同毕业的足彩同志，你们在他乡可否中奖？

'// This code is writed by lovelyccc
'// Develop in home
'// 2006/9/9
'// In ShenZhen province of China
Option Explicit
Public temp(), temp1(), temp2(), temp3()
'//temp是投注号,temp1是在1列显示的投注号,temp2是在2列显示的投注号
'//temp3临时储存temp1的投注号，防止temp1的数据在过滤过程中被篡改
Public finalno()
'//finalno是过滤号
Public a1(), a2(), a3(), a4(), a5(), a6(), a7(), a8(), a9(), a10(), a11(), a12(), a13(), a14()
Public L1(), L2(), L3(), L4(), L5(), L6(), L7()
Public T1(), T2(), T3()
Public LT1(), LT2()
Public Lottery()
Public GridcloPosition As Integer
Public ArrayLenth As Integer
Public BeforePosition As Integer
Public Function Loop2Times()Function Loop2Times(ByRef c1(), ByRef c2())
On Error GoTo err
Dim i, j, l, k As Integer
k = 0
l = (UBound(c1) + 1) * (UBound(c2) + 1)
ReDim temp(l - 1)
For i = LBound(c1) To UBound(c1)
    For j = LBound(c2) To UBound(c2)
        temp(k) = c1(i) & c2(j)
        k = k + 1
    Next
Next
Exit Function
err:
   MsgBox "错误" & err.Description
End Function
Public Function InitArray()Function InitArray()
Dim i As Integer
Dim count As Integer
count = 1
'//////////////////////////////原始数组1///////////////////////////
If FrmLottery.Check1(1).Value = 1 Then
   a1() = Array("3")
   If FrmLottery.Check1(2).Value = 1 Then
      a1() = Array("3", "1")
      If FrmLottery.Check1(3).Value = 1 Then
         a1() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(3).Value = 1 Then
         a1() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(2).Value = 1 Then
      a1() = Array("1")
      If FrmLottery.Check1(3).Value = 1 Then
         a1() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(3).Value = 1 Then
         a1() = Array("0")
      Else
         a1() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组2///////////////////////////
If FrmLottery.Check1(4).Value = 1 Then
   a2() = Array("3")
   If FrmLottery.Check1(5).Value = 1 Then
      a2() = Array("3", "1")
      If FrmLottery.Check1(6).Value = 1 Then
         a2() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(6).Value = 1 Then
         a2() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(5).Value = 1 Then
      a2() = Array("1")
      If FrmLottery.Check1(6).Value = 1 Then
         a2() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(6).Value = 1 Then
         a2() = Array("0")
      Else
         a2() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组3///////////////////////////
If FrmLottery.Check1(7).Value = 1 Then
   a3() = Array("3")
   If FrmLottery.Check1(8).Value = 1 Then
      a3() = Array("3", "1")
      If FrmLottery.Check1(9).Value = 1 Then
         a3() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(9).Value = 1 Then
         a3() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(8).Value = 1 Then
      a3() = Array("1")
      If FrmLottery.Check1(9).Value = 1 Then
         a3() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(9).Value = 1 Then
         a3() = Array("0")
      Else
         a3() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组4///////////////////////////
If FrmLottery.Check1(10).Value = 1 Then
   a4() = Array("3")
   If FrmLottery.Check1(11).Value = 1 Then
      a4() = Array("3", "1")
      If FrmLottery.Check1(12).Value = 1 Then
         a4() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(12).Value = 1 Then
         a4() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(11).Value = 1 Then
      a4() = Array("1")
      If FrmLottery.Check1(12).Value = 1 Then
         a4() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(12).Value = 1 Then
         a4() = Array("0")
      Else
         a4() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组5///////////////////////////
If FrmLottery.Check1(13).Value = 1 Then
   a5() = Array("3")
   If FrmLottery.Check1(14).Value = 1 Then
      a5() = Array("3", "1")
      If FrmLottery.Check1(15).Value = 1 Then
         a5() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(15).Value = 1 Then
         a5() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(14).Value = 1 Then
      a5() = Array("1")
      If FrmLottery.Check1(15).Value = 1 Then
         a5() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(15).Value = 1 Then
         a5() = Array("0")
      Else
         a5() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组6///////////////////////////
If FrmLottery.Check1(16).Value = 1 Then
   a6() = Array("3")
   If FrmLottery.Check1(17).Value = 1 Then
      a6() = Array("3", "1")
      If FrmLottery.Check1(18).Value = 1 Then
         a6() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(18).Value = 1 Then
         a6() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(17).Value = 1 Then
      a6() = Array("1")
      If FrmLottery.Check1(18).Value = 1 Then
         a6() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(18).Value = 1 Then
         a6() = Array("0")
      Else
         a6() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组7///////////////////////////
If FrmLottery.Check1(19).Value = 1 Then
   a7() = Array("3")
   If FrmLottery.Check1(20).Value = 1 Then
      a7() = Array("3", "1")
      If FrmLottery.Check1(21).Value = 1 Then
         a7() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(21).Value = 1 Then
         a7() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(20).Value = 1 Then
      a7() = Array("1")
      If FrmLottery.Check1(21).Value = 1 Then
         a7() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(21).Value = 1 Then
         a7() = Array("0")
      Else
         a7() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组8///////////////////////////
If FrmLottery.Check1(22).Value = 1 Then
   a8() = Array("3")
   If FrmLottery.Check1(23).Value = 1 Then
      a8() = Array("3", "1")
      If FrmLottery.Check1(24).Value = 1 Then
         a8() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(24).Value = 1 Then
         a8() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(23).Value = 1 Then
      a8() = Array("1")
      If FrmLottery.Check1(24).Value = 1 Then
         a8() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(24).Value = 1 Then
         a8() = Array("0")
      Else
         a8() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组9///////////////////////////
If FrmLottery.Check1(25).Value = 1 Then
   a9() = Array("3")
   If FrmLottery.Check1(26).Value = 1 Then
      a9() = Array("3", "1")
      If FrmLottery.Check1(27).Value = 1 Then
         a9() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(27).Value = 1 Then
         a9() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(26).Value = 1 Then
      a9() = Array("1")
      If FrmLottery.Check1(27).Value = 1 Then
         a9() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(27).Value = 1 Then
         a9() = Array("0")
      Else
         a9() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组10///////////////////////////
If FrmLottery.Check1(28).Value = 1 Then
   a10() = Array("3")
   If FrmLottery.Check1(29).Value = 1 Then
      a10() = Array("3", "1")
      If FrmLottery.Check1(30).Value = 1 Then
         a10() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(30).Value = 1 Then
         a10() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(29).Value = 1 Then
      a10() = Array("1")
      If FrmLottery.Check1(30).Value = 1 Then
         a10() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(30).Value = 1 Then
         a10() = Array("0")
      Else
         a10() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组11///////////////////////////
If FrmLottery.Check1(31).Value = 1 Then
   a11() = Array("3")
   If FrmLottery.Check1(32).Value = 1 Then
      a11() = Array("3", "1")
      If FrmLottery.Check1(33).Value = 1 Then
         a11() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(33).Value = 1 Then
         a11() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(32).Value = 1 Then
      a11() = Array("1")
      If FrmLottery.Check1(33).Value = 1 Then
         a11() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(33).Value = 1 Then
         a11() = Array("0")
      Else
         a11() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组12///////////////////////////
If FrmLottery.Check1(34).Value = 1 Then
   a12() = Array("3")
   If FrmLottery.Check1(35).Value = 1 Then
      a12() = Array("3", "1")
      If FrmLottery.Check1(36).Value = 1 Then
         a12() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(36).Value = 1 Then
         a12() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(35).Value = 1 Then
      a12() = Array("1")
      If FrmLottery.Check1(36).Value = 1 Then
         a12() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(36).Value = 1 Then
         a12() = Array("0")
      Else
         a12() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组13///////////////////////////
If FrmLottery.Check1(37).Value = 1 Then
   a13() = Array("3")
   If FrmLottery.Check1(38).Value = 1 Then
      a13() = Array("3", "1")
      If FrmLottery.Check1(39).Value = 1 Then
         a13() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(39).Value = 1 Then
         a13() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(38).Value = 1 Then
      a13() = Array("1")
      If FrmLottery.Check1(39).Value = 1 Then
         a13() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(39).Value = 1 Then
         a13() = Array("0")
      Else
         a13() = Array("*")
      End If
   End If
End If
'//////////////////////////////原始数组14///////////////////////////
If FrmLottery.Check1(40).Value = 1 Then
   a14() = Array("3")
   If FrmLottery.Check1(41).Value = 1 Then
      a14() = Array("3", "1")
      If FrmLottery.Check1(42).Value = 1 Then
         a14() = Array("3", "1", "0")
      End If
   Else
      If FrmLottery.Check1(42).Value = 1 Then
         a14() = Array("3", "0")
      End If
   End If
Else
   If FrmLottery.Check1(41).Value = 1 Then
      a14() = Array("1")
      If FrmLottery.Check1(42).Value = 1 Then
         a14() = Array("1", "0")
      End If
   Else
      If FrmLottery.Check1(42).Value = 1 Then
         a14() = Array("0")
      Else
         a14() = Array("*")
      End If
   End If
End If
End Function
Public Function MakeLotteryNumber()Function MakeLotteryNumber()
'//////////////////////////第一轮合并/////////////////////////
Call Loop2Times(a1, a2)
L1 = temp
Call Loop2Times(a3, a4)
L2 = temp
Call Loop2Times(a5, a6)
L3 = temp
Call Loop2Times(a7, a8)
L4 = temp
Call Loop2Times(a9, a10)
L5 = temp
Call Loop2Times(a11, a12)
L6 = temp
Call Loop2Times(a13, a14)
L7 = temp
'//////////////////////////第二轮合并/////////////////////////
Call Loop2Times(L1, L2)
T1 = temp
Call Loop2Times(L3, L4)
T2 = temp
Call Loop2Times(L5, L6)
T3 = temp
'//////////////////////////第三轮合并/////////////////////////
Call Loop2Times(T1, T2)
LT1 = temp
Call Loop2Times(T3, L7)
LT2 = temp
'/////////////////////////生成投注号//////////////////////////
Call Loop2Times(LT1, LT2)
Lottery = temp
End Function
Public Function InitMSHFlexGrid1()Function InitMSHFlexGrid1()
On Error Resume Next
Dim i%
Dim width(), name()
width = Array("800", "1865", "1865", "1865")
name = Array("序号", "投注号1", "投注号2", "过滤号")
With FrmLottery.MSHFlexGrid1
     .FixedRows = 1
     .FixedCols = 0
     .Cols = 4
     .Rows = 32000
End With
For i = 0 To 3
    FrmLottery.MSHFlexGrid1.ColWidth(i) = width(i)
    FrmLottery.MSHFlexGrid1.TextMatrix(0, i) = Space(6) & name(i)
Next
FrmLottery.MSHFlexGrid1.TextMatrix(0, 0) = Space(2) & name(0)
For i = 1 To FrmLottery.MSHFlexGrid1.Rows
    FrmLottery.MSHFlexGrid1.TextMatrix(i, 0) = Format(i, "0000")
Next
End Function
Public Function DisplayLotteryNumber()Function DisplayLotteryNumber(ByRef c1())
On Error GoTo err
Dim i, t As Integer
t = BeforePosition
'////////////////////初始化在表格中显示的位置////////////////
If FrmLottery.Check2(0).Value = 1 Then
   GridcloPosition = 1
   BeforePosition = GridcloPosition
Else
   If FrmLottery.Check2(1).Value = 1 Then
       GridcloPosition = 2
       BeforePosition = GridcloPosition
   Else
       GridcloPosition = 1
       BeforePosition = GridcloPosition
   End If
End If
'////////////////////初始化表格的行数////////////////////////
ArrayLenth = UBound(c1) + 1
   'FrmLottery.MSHFlexGrid1.Rows = ArrayLenth + 1

'///////////////////清空表格中的某列/////////////////////////
If BeforePosition = 1 Then
   temp1 = temp
   FrmLottery.Label3.Caption = "共计：" & UBound(c1) + 1 & "注"
   For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
       FrmLottery.MSHFlexGrid1.TextMatrix(i, 1) = ""
   Next
ElseIf BeforePosition = 2 Then
   temp2 = temp
   FrmLottery.Label5.Caption = "共计：" & UBound(c1) + 1 & "注"
   For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
       FrmLottery.MSHFlexGrid1.TextMatrix(i, 2) = ""
   Next
End If
'////////////////////在表格中显示数组////////////////////////
For i = 1 To UBound(c1) + 1
    FrmLottery.MSHFlexGrid1.TextMatrix(i, GridcloPosition) = c1(i - 1)
    'FrmLottery.MSHFlexGrid1.TopRow = FrmLottery.MSHFlexGrid1.TopRow + 1
Next
Exit Function
err:
   MsgBox "错误" & err.Description
End Function
Public Function Change3toGridclo12()Function Change3toGridclo12(ByVal colno As Integer)
Dim i, k As Integer
For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
    FrmLottery.MSHFlexGrid1.TextMatrix(i, colno) = FrmLottery.MSHFlexGrid1.TextMatrix(i, 3)
    FrmLottery.MSHFlexGrid1.TextMatrix(i, 3) = ""
Next
For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
    If FrmLottery.MSHFlexGrid1.TextMatrix(i, 3) <> "" Then
           k = k + 1
    End If
Next
If colno = 1 Then
    FrmLottery.Label3.Caption = "共计：" & k & "注"
    FrmLottery.Label6.Caption = ""
Else
    FrmLottery.Label5.Caption = "共计：" & k & "注"
    FrmLottery.Label6.Caption = ""
End If
End Function
Public Function Change12toGridclo21()Function Change12toGridclo21(ByVal a As Integer, ByVal b As Integer)
Dim i, k As Integer
k = 0
For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
    FrmLottery.MSHFlexGrid1.TextMatrix(i, a) = FrmLottery.MSHFlexGrid1.TextMatrix(i, b)
    FrmLottery.MSHFlexGrid1.TextMatrix(i, b) = ""
Next
For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
    If FrmLottery.MSHFlexGrid1.TextMatrix(i, a) <> "" Then
           k = k + 1
    End If
Next
If a = 1 Then
    FrmLottery.Label3.Caption = "共计：" & k & "注"
    FrmLottery.Label5.Caption = ""
Else
    FrmLottery.Label5.Caption = "共计：" & k & "注"
    FrmLottery.Label3.Caption = ""
End If
End Function
Public Function DiscardSomenumber()Function DiscardSomenumber()
On Error GoTo err
Dim i, j, k, l As Integer
temp3 = temp1
For i = 0 To UBound(temp1)
    For j = 0 To UBound(temp2)
        If temp3(i) = temp2(j) Then
           temp3(i) = "/"
        End If
    Next
Next
'/////////////初始化过滤数组/////////////////////////
k = 0
For i = 0 To UBound(temp3)
    If temp3(i) <> "/" Then
       k = k + 1
    End If
Next
ReDim finalno(k - 1)
l = 0
For i = 0 To UBound(temp1)
    If temp3(i) <> "/" Then
       finalno(l) = temp3(i)
       l = l + 1
    End If
Next
'//////////////clear col4////////////////////////////
For i = 1 To FrmLottery.MSHFlexGrid1.Rows - 1
       FrmLottery.MSHFlexGrid1.TextMatrix(i, 3) = ""
Next
'//////////////////用过滤数组给表格第四列赋值////////
'k = 1
For i = 0 To UBound(finalno)
    FrmLottery.MSHFlexGrid1.TextMatrix(i + 1, 3) = finalno(i)
    'k = k + 1
Next
'For i = 0 To UBound(temp1)
    'If temp3(i) <> "/" Then
       'FrmLottery.MSHFlexGrid1.TextMatrix(k, 3) = temp3(i)
       'k = k + 1
    'End If
'Next
FrmLottery.Label6.Caption = "共计：" & UBound(finalno) + 1 & "注"
Exit Function
err:
   MsgBox "错误" & err.Description
End Function
Public Sub OutDataToText()Sub OutDataToText(Flex As MSHFlexGrid)
    Dim s As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim strTemp As String
    Dim sql As String
    
   ' On Error GoTo Ert
    FrmLottery.MousePointer = 11
    'On Error Resume Next
    DoEvents
    'Dim FileNum As Integer
    'FileNum = FreeFile
    Dim fs As Object, a As Object
    Dim path As String
    Dim b As String
    Set fs = CreateObject("scripting.filesystemobject")
'fs.CreateFolder ("d: est")
    b = Format(Time, "HH.MM")
    'path = "d: est" & b & ".txt"
   Set a = fs.CreateTextFile("d: LotteryNumber.txt", True)
  
    
        With Flex
            k = .Rows
            For i = 0 To k - 1
                strTemp = ""
                For j = 0 To .Cols - 1
                    DoEvents
                    strTemp = strTemp & .TextMatrix(i, j) & "  "
                Next j
                a.WriteLine (strTemp)
            Next i
        End With
   a.Close
    FrmLottery.MousePointer = 0
    MsgBox "导出成功"
    Exit Sub
Ert:
    MsgBox err.Description
    FrmLottery.MousePointer = 0
End Sub

       因为时间匆促，没有做进一步的改进，一次投注数限制在31000，如果能够向网络发展，并丰富过滤算法，相信是一个不错的投注师。软件的灵魂是算法，相信各位达人不需要我描述界面设计了,哈哈！

       我的QQ：是274307463，手机是：13267217075（深圳），EMAIL：[e-mail]

       人往高处走，水往低处流

     BLOG注册不久，欢迎程序江湖中的达人来我的博客做客，留言，让我能够更快的进步！