趣味のエクセルで当てよう!ロト・ナンバーズ

当選狙いで、ナンバーズ4をメインにロト、ビンゴ5などの各種データリストや、それらの分析用エクセルVBAなどについて書いてます。

ロト6出目出現間隔を配列で計算

記事目次 ロト・ビンゴ 



表の左の当選データから右側の様に出目出現間隔を配列マクロで出して見た。
(1回目と連続当選データの間隔は0とするゲイルハワードの真似をしてます)
セルを直接指定するマクロでの計算結果がおかしいのと時間が掛かるので。
この配列マクロには一部おかしいところが有ります。


Sub loto6出目出現間隔計算配列()


Dim starttime As Single, stoptime As Single
starttime = Timer


Dim i As Long, j As Long, jj As Long, gk As Long
Dim gok(43, 500) As Long, gokk(43, 500) As Long
Dim t As Long, s As Long, r As Long, n As Long
Dim k(43) As Long, tt(43) As Long


Dim allmydataArr As Variant
allmydataArr = Range("a1").CurrentRegion.Value

Call saikeisanoff


For i = 2 To UBound(allmydataArr, 1)'2行目~最終行まで


 For n = 2 To 8 '当選データの2~8列

      gk = allmydataArr(i, n) '出目
     k(gk) = k(gk) + 1 '該当データ数計算
     gok(gk, k(gk)) = allmydataArr(i, 1) '該当データの回号を格納
     tt(gk) = gok(gk, k(gk)) '該当データの最終回号

 Next n
Next i


For s = 1 To 43 '回号から間隔計算 '最初と連続出現は間隔0とする (-1で計算)
 For j = 1 To k(s)


  If j = 1 Then
   gokk(s, j) = gok(s, j) - 1 '最初の回号の時
  Else
   gokk(s, j) = gok(s, j) - gok(s, j - 1) - 1
  End If
 Next j


Next s


For r = 1 To 43 '合計各回号出力 最初回から出目1~43

 For jj = k(r) To 1 Step -1

   Cells(501 - jj, 20 + r) = gokk(r, k(r) - jj + 1) '各出目の最初の間隔から出力
 Next jj


Next r


For t = 1 To 43


Cells(501, t + 20) = k(t) '出現回数
Cells(502, t + 20) = UBound(allmydataArr, 1) - tt(t) -1 '現状はまり回数
Cells(504, t + 20) = tt(t) '最終出現回号
Cells(505, t + 20) = t '出目1~43


Next t

Call saikeisanon
stoptime = Timer
MsgBox "件数は" & k(13) & " 時間は" & Round(stoptime - starttime, 4)

End Sub


------------------------------------------------------------------------------------------------
Public Sub saikeisanoff()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False '画面変更をしない。
End Sub


------------------------------------------------------------------------------------------------
Public Sub saikeisanon()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
Application.ScreenUpdating = True '画面変更
End Sub