关于重复连续次数与间隔之最值的探讨

万林

近段时间，彩友们给我设计统计一些彩票的规律，其中就是求出现次数、最大遗漏、最大连续出现（连号）数、最大不连号、平均遗漏、平均连号、平均遗漏等。根据彩友们的需要，本人用EXCEL设计两张表，一张用来存放各期开奖号码的情况，另一张用来设计统计彩友的需要数据。如下图：
]
当前出现次数：统计各种走势情况出现的次数。
当前最大遗漏：统计各种走势情况在查询期间中前次与后次出现的间隔的最大值。
当前最大连号：统计各种走势情况在查询期间连续重复出现的最大重复数。
当前最大不连号：统计各种走势情况在查询期间重复出现前后两次之间间隔的最大值。即前次重复与后一次重复之间的间隔的最大值，可理解为连号遗漏。

计算公式如下：

当前出现次数       =COUNTIF(E$6:E311,E$5）=SUM(IF(分析区域=E$5,1,0)) 前者往往将文本数字与数字误为一样，后者可以解决这个问题了。

当前出现频率 =COUNTIF(E$6:E311,E$5)/ROWS(E$6:E311)*100=INT(SUM(IF(分析区域=E$5,1,0))/ROWS(分析区域)*100)，与上述相同前者往往将文本数字与数字误为一样

当前最大遗漏    =MAX(E$5:E311）

{=MAX(--FREQUENCY(IF(E6:E311<>E$5,ROW(6:311)),IF(E6:E311=E$5,ROW(6:311))))}

平均遗漏=INT(SUM(--FREQUENCY(IF(分析区域<>下行区域,ROW(分析区域)),IF(分析区域=E$5,ROW(分析区域))))/COUNT(IF(--FREQUENCY(IF(分析区域<>下行区域,ROW(分析区域)),IF(分析区域=E$5,ROW(分析区域)))=0,"",)))

{=AVEDEV(--FREQUENCY(IF(E6:E311<>E$5,ROW(6:311)),IF(E6:E311=E$5,ROW(6:311))))}这个公式将

当前最大连号  ={MAX(--FREQUENCY(IF(E6:E311=E$5,ROW(6:311)),IF(E6:E311<>E$5,ROW(6:311))))}

当前最大不连号间隔（连号遗漏）={MAX(--FREQUENCY(IF(E6:E311<>E7:E312,ROW(6:311)),IF(E6:E311=E7:E312,ROW(6:311))))}

当前最小不连号间隔={IF(SMALL(--FREQUENCY(IF(E7:E311<>E6:E310,ROW(6:310)),IF(E7:E311=E6:E310,IF(ROW(6:310)<COUNT(E6:E310)+1,ROW(6:310)))),1)>0,SMALL(FREQUENCY(IF(E7:E311<>E6:E310,ROW(6:310)),IF(E7:E311=E6:E310,IF(ROW(6:310)<COUNT(E6:E310)+1,ROW(6:310)))),1)-1,)}

万林

=COUNTIF(E$6:E311,E$5)/ROWS(E$6:E311)*100

万林

设计VBA代码如下：
Sub 按选择期数查询排三走势()
Dim r As Long, r1 As Long, r2 As Long, r3 As Long
Dim sht As Worksheet, sht1 As Worksheet
Set sht = Sheets("排三走势")
Set sht1 = Sheets("排三开奖号码")
r = sht1.Range("A65536").End(xlUp).Row
r1 = Application.Match(sht.Cells(2, 2), sht1.Range("A3:A" & r), 0) + 2
r2 = Application.Match(sht.Cells(2, 7), sht1.Range("A3:A" & r), 0) + 2
If r1 - r2 >= 0 Then
MsgBox ("查询期数设置不正确，请重新设置！")
Else
r3 = sht.Range("A65536").End(xlUp).Row
sht.Range("A7:DS" & r3).Clear
sht1.Range("A" & r1 & ":A" & r2).Copy sht.[A6]
sht1.Range("B" & r1 & ":D" & r2).Copy sht.[B6]
sht.Range("E6:DS6").AutoFill Destination:=sht.Range("E6:DS" & r2 - r1 + 6), Type:=xlFillDefault '填充
r3 = sht.Range("A65536").End(xlUp).Row
sht.Range("A" & r3 + 2) = "当前出现次数"
sht.Range("A" & r3 + 3) = "当前最大遗漏"
sht.Range("A" & r3 + 4) = "当前最大连号"
sht.Range("A" & r3 + 5) = "当前最大不连号间隔"
sht.Range("A" & r3 + 6) = "当前最小不连号间隔"
'计算当前出现次数
sht.Range("E" & r3 + 2).Formula = "=COUNTIF(E$6:E" & r3 & ",E$5)"   '在编辑输入公式
sht.Range("E" & r3 + 2).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 2 & ":DS" & r3 + 2)   ' 利用填充柄填充公式（是否可以引用数组区域直接填入公式呢？）
'计算当前最大遗漏
sht.Range("E" & r3 + 3).Formula = "=max(E$5:E" & r3 & ")"
sht.Range("E" & r3 + 3).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 3 & ":DS" & r3 + 3)
'计算当前最大连号数
sht.Range("E" & r3 + 4).FormulaArray = _
"=MAX(FREQUENCY(IF(E6:E" & r3 & "=E$5,ROW(6:" & r3 & ")),IF(E6:E" & r3 & "<>E$5,ROW(6:" & r3 & "))))"
sht.Range("E" & r3 + 4).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 4 & ":DS" & r3 + 4)
'计算当前最大的不连号间隔
sht.Range("E" & r3 + 5).FormulaArray = _
"=MAX(FREQUENCY(IF(E6:E" & r3 & "<>E7:E" & r3 + 1 & ",ROW(6:" & r3 & ")),IF(E6:E" & r3 & "=E7:E" & r3 + 1 & ",ROW(6:" & r3 & "))))"
sht.Range("E" & r3 + 5).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 5 & ":DS" & r3 + 5)
'计算当前最小的不连号间隔
sht.Range("E" & r3 + 6).FormulaArray = _
"=SMALL(FREQUENCY(IF(E7:E" & r3 & "<>E6:E" & r3 - 1 & ",ROW(6:" & r3 - 1 & ")),IF(E7:E" & r3 & "=E6:E" & r3 - 1 & ",IF(ROW(6:" & r3 - 1 & ")<COUNT(E6:E" & r3 - 1 & ")+1,ROW(6:" & r3 - 1 & "))))，1)"
sht.Range("E" & r3 + 6).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 6 & ":DS" & r3 + 6)

sht.Range("A" & r3 + 2 & ":DS" & r3 + 6).Font.Size = 10 '设置字号为10号

'以下是设置条件格式，以显示特别规律性
sht.Range("G" & r3 + 2 & ":AJ" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(G" & r3 + 2 & ",$G" & r3 + 2 & ":$AJ" & r3 + 2 & ")<=5"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With
sht.Range("AT" & r3 + 2 & ":BA" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(AT" & r3 + 2 & ",$AT" & r3 + 2 & ":$BA" & r3 + 2 & ")=1"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With
sht.Range("BK" & r3 + 2 & ":BR" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(BK" & r3 + 2 & ",$BK" & r3 + 2 & ":$BR" & r3 + 2 & ")=1"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With
sht.Range("CB" & r3 + 2 & ":CI" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(CB" & r3 + 2 & ",$CB" & r3 + 2 & ":$CI" & r3 + 2 & ")=1"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With
sht.Range("CQ" & r3 + 2 & ":CT" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(CQ" & r3 + 2 & ",$CQ" & r3 + 2 & ":$CT" & r3 + 2 & ")=1"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With
sht.Range("DE" & r3 + 2 & ":DH" & r3 + 3 & "").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RANK(DE" & r3 + 2 & ",$DE" & r3 + 2 & ":$DH" & r3 + 2 & ")=1"
With Selection.FormatConditions(1).Font
        .Bold = True
        .ColorIndex = 3
End With

End If
Set sht = Nothing
Set sht1 = Nothing
End Sub

万林

上述红色部分代码如何优化？请高手指教。

万林

为减小文件空间，附件中删除大量的历来开奖号码，现上传参考讨论，请各位帮助优化一下代码。

万林

计算当前最小的不连号间隔
sht.Range("E" & r3 + 6).FormulaArray = _
"=SMALL(FREQUENCY(IF(E7:E" & r3 & "<>E6:E" & r3 - 1 & ",ROW(6:" & r3 - 1 & ")),IF(E7:E" & r3 & "=E6:E" & r3 - 1 & ",IF(ROW(6:" & r3 - 1 & ")<COUNT(E6:E" & r3 - 1 & ")+1,ROW(6:" & r3 - 1 & "))))，1)"
sht.Range("E" & r3 + 6).Select
Selection.AutoFill Destination:=sht.Range("E" & r3 + 6 & ":DS" & r3 + 6)

这部分代码有数时比实际数多1

童真

学习学习！

jiminyanyan

童真 发表于 2012-3-27 17:59
学习学习！

复杂的说。。。。

suwenkai

看高手怎么优化{:soso_e113:}

闷爱

请问一下，最新间隔公式如何写，A列数据，B列为判断公式，能帮帮忙吗？谢谢！
判断组三组六，单双，大小，012路，谢谢了