分区分析.txt

用于分析彩票排列3的一组源码。共5个

==========================================================
'             分 区 分 析
'==========================================================

'号码段设置
CpParam.AddBtn "OnButton", "分段设置"
set CpSec = CreateObject("BoaoHbsActive.CpSec")
TmpFile =  "Module\"&CpData.Name&"_分段.tmp"
Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FileExists(TmpFile)) Then
    CpSec.Load TmpFile
  Else
    CpSec.Add "01-05=01 02 03 04 05"
    CpSec.Add "06-10=06 07 08 09 10"
    CpSec.Add "11-15=11 12 13 14 15"
    CpSec.Add "16-20=16 17 18 19 20"
    CpSec.Add "21-25=21 22 23 24 25"
    CpSec.Add "26-30=26 27 28 29 30"
    CpSec.Add "31-35=31 32 33 34 35"
    CpSec.Add "36-37=36 37"
  End If
Function OnButton
  If CpDlg.Sec(CpSec, CpData.MinCode, CpData.CodeCount) Then        
    CpSec.Save TmpFile
    OnButton = True
  Else
    OnButton = False
  End If  	
End Function

Function Main
  '===============申明或定义变量=============
  CpRowCount = CpData.RowCount  '开奖期数
  CpColCount = CpData.ColCount '开奖号码个数
  CpMaxCode = CpData.MaxCode   '号码数量
  CpMinCode = CpData.MinCode       '最小号码

  '=================建表=================
  CpAna.AddField "期号",8
  CpAna.AddField "开奖号码",CpColCount*3
  For i = 1 to CpColCount
    CpAna.AddField "基"&i, 4
  Next
  CpAna.AddField "范围",4
  CpAna.AddField "区排列",20
  CpAna.AddField "总值",4
  CpAna.AddField "排值",4
  CpAna.AddField "连区组数",8
  CpAna.AddField "连区描述",8
  CpAna.AddField "重复上期",20
  CpAna.AddField "重复区数",8

  CpAna.RowCount = CpRowCount
  CpAna.CreateTable()

  '==============算法主体============================
  HmdCount = CpSec.Count
  ReDim Nums(CpColCount)
  ReDim PL(HmdCount)'排列  下标为段序号，值为在该段中的号码个数
  ReDim PrePL(HmdCount)'上期排列，为求上期重复情况
  For row = 0 to CpRowCount - 1
    For col = 0 to CpColCount - 1
      Nums(col) = CpData.Code(row,col)
    Next

    CpAna.Cell(row, "期号") = CpData.Seq(row)
    CpAna.Cell(row, "开奖号码") = CpData.CodeStr(row)

    For i = 0 to HmdCount-1
      PL(i) = 0
    Next
    For i = 0 to cpColCount-1
      index = CpSec.IndexOf(Nums(i))
      If (index >= 0) Then
        PL(index) = PL(index) + 1
        CpAna.Cell(row, "基"&i+1) = index+1
        CpAna.Color(row, "基"&i+1) = CpColor.IndexOf(index+1)
      End If
    Next

    '求总值
    sum1 = 0'排值
    sum2 = 0'总值
    count = 0'范围
    PlStr = ""'区排列

    For i = 0 to HmdCount-1
      '求总值
      If PL(i) > 0 Then
        count = count + 1
        If PlStr <> "" Then
          PlStr = PlStr & ","
        End If
        PlStr = PlStr & (i + 1) 
        sum1 = sum1 + i + 1
        sum2 = sum2 + (i+1)*PL(i)
      End If 
    
    Next
    CpAna.Cell(row, "范围") = count
    CpAna.Cell(row, "区排列") = PlStr
    CpAna.Cell(row, "总值") = sum2
    CpAna.Cell(row, "排值") = sum1
   
    '求连区
    count = 0 '连区数	  
    sum = 0'连区组数
    LQStr = ""'连区描述
    For i = 0 to HmdCount-1
      If PL(i) = 0 Then
        If count > 1 Then
          If LQStr = "" Then
            LQStr = CStr(count)
          Else
            LQStr = LQStr & "+" & count
          End If
          sum = sum + 1
        End If
        count = 0
      Else
        count = count + 1
      End If
    Next
  
    If count > 1 Then
      If LQStr = "" Then
        LQStr = CStr(count)
      Else
        LQStr = LQStr & "+" & count
      End If
      sum = sum + 1
    End If
    CpAna.Cell(row, "连区组数") = sum
    CpAna.Cell(row, "连区描述") = LQStr
  
    '求重复上期
    CFStr = ""'重复上期
    count = 0'重复期数
    If (row > 0) Then
      For i = 0 to HmdCount - 1
        If PL(i) > 0 And PrePL(i) > 0 Then
          count = count + 1
          If CFStr = "" Then
            CFStr = CStr(i+1)
          Else
            CFStr = CFStr & "," & CStr(i+1)
          End If
        End If
      Next
    End If
  
    CpAna.Cell(row, "重复上期") = CFStr
    CpAna.Cell(row, "重复区数") = count

    '备份本期排列情况，以备下期使用
    For i = 0 to HmdCount-1  
      PrePL(i) = PL(i)
    Next
  Next
End Function