ムラゴン ホーム
2.LOTO6SLJ
ロト6において、第1の番号と残りの6つの番号の組み合わせをペア集計します。同じように第2の番号と残りの5つ、第3、第4、第5、第6も同じようにします。
出目に対応したセルを作っておいてそこで計算と出力してます。
（ボーナス番号は除く）
Sub 同伴数字()'ロト6で何と何が一緒に出ているのか？集計する。
Dim i As long, kaigo As long, xa As long, ya As long
Dim a As long, b As long, c As long, d As long, e As long
Sheets("最後当選").Select
If Cells(1, 1) <> Cells(1, 2) Then Sheets("同伴数字").Select: End
Range("B3:H1300").Select
Selection.Copy ’シート最後当選のデータをシート同伴数字にコピーする。
Sheets("同伴数字").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K4:BA46").Select
Selection.ClearContents
saikeisanoff ' 再計算を止めるサブルーチン（マクロ処理速度アップさせる）
i = 1
Do Until Cells(i, 1) = ""
For a = 1 To 6 '1,2,3,4,5,6,7
xa = Cells(i, 1) '最初数字
ya = Cells(i, a + 1) '次回以降数字2～7まで6つ
'Cells(ya + 3, xa + 10)は基準は4行目の11列目ya , xa で変化させる
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
Next a
For b = 1 To 5 '2,3,4,5,6,7
xa = Cells(i, 2) '2番目の数字
ya = Cells(i, b + 2) '次回以降数字3～7まで5つ
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
Next b
For c = 1 To 4 '3,4,5,6,7
xa = Cells(i, 3) '3番目の数字
ya = Cells(i, c + 3)
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
Next c
For d = 1 To 3 '4,5,6,7
xa = Cells(i, 4) '4番目の数字
ya = Cells(i, d + 4)
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
Next d
For e = 1 To 2 '5,6,7
xa = Cells(i, 5) '5番目の数字
ya = Cells(i, e + 5)
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
Next e
xa = Cells(i, 6) '6番目の数字
ya = Cells(i, 7)
Cells(ya + 3, xa + 10) = Cells(ya + 3, xa + 10) + 1 ’対応セルに集計
Cells(xa + 3, ya + 10) = Cells(xa + 3, ya + 10) + 1 ’対応セルに集計
i = i + 1
If i = 1500 Then Exit Do
Loop
kaigo = Application.CountA(Range(Cells(1, 1), Cells(1300, 1)))
Cells(2, 24) = kaigo
saikeisanon ' 再計算をするサブルーチンマクロ
End Sub
--------------------------------------------------------------------------------------
前回と次回の番号の関係
変数 知らなかった本当の使い方
Sub after_no() 'ロト6で後追い数字 どの番号の後にどんな番号が出ているのか？
Dim i As long, ii As long, iii As long, countre As long
Dim xa As long, ya As long
Sheets("最後当選").Select
countre = Cells(1, 1)
Range("B3:H5000").Select
Selection.Copy
Sheets("後追数字").Select
Range("A1").Select
ActiveSheet.Paste
Range("AB4:BR46") = 0
i = 0: ii = 0: iii = 0
saikeisanoff
For i = 2 To countre
For ii = 1 To 7
xa = Cells(i - 1, ii) '最初数字1,1
For iii = 1 To 7
ya = Cells(i, iii) '次回以降数字1,2
Cells(3 + ya, 27 + xa) = Cells(3 + ya, 27 + xa) + 1
Next iii
Next ii
Next i
Cells(2, 28) = "=max(AB4:AB46)"
saikeisanon
Cells(1, 9) = countre & "回"
Range("AB4:BR46").Select ’マクロ自動記録でランク付（平均との比較色分け）
Selection.FormatConditions.AddAboveAverage
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).AboveBelow = xlAboveAverage
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.AddAboveAverage
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).AboveBelow = xlBelowAverage
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Sheets("後追数字").Select
Range("aa１").Select
End Sub
--------------------------------------------------------------------------------------
Sub p_1()
retu = ActiveCell.Column
gyou = ActiveCell.Row
Cells(gyou, retu) = Cells(gyou, retu) + 1
End Sub
'各シートへ移動する。
Sub 略式最後へ()
Sheets("略式最後").Select
End Sub
Sub 最後当選へ()
Sheets("最後当選").Select
End Sub
Sub 統計一覧へ()
Sheets("統計一覧").Select
End Sub
Sub 多重当選へ()
Sheets("多重当選").Select
End Sub
Sub 隣組へ()
Sheets("となり組").Select
End Sub
Sub 占星術へ()
Sheets("占星術").Select
End Sub
Sub 偏り追跡へ()
Sheets("偏り追跡").Select
End Sub
Sub 合計偏りへ()
Sheets("合計偏り").Select
End Sub
Sub 同伴数字へ()
Sheets("同伴数字").Select
End Sub
------------------------------------------------------------------------------------------------------------
Sub 縦書き()
Sheets("偏り追跡").Select
gyou = ActiveCell.Row
Range("a10:a1500").Clear
Range("R1:W1").Select
Selection.Copy
Cells(gyou, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
--------------------------------
Sub 左へ整列()
Dim data_43(300) As Integer
retu_1 = ActiveCell.Column
gyou = ActiveCell.Row
Erase data_43
i = 0
Do Until Cells(gyou, retu_1 - i) = ""
data_43(i) = Cells(gyou, retu_1 - i)
If Cells(gyou, retu_1 - i) = "" Then Exit Do
i = i + 1
j = i
Loop
For i = 0 To j
data_43(i) = Cells(gyou, retu_1 - i - 1) = data_43(i)
Next i
End Sub
--------------------------------------------
Sub 空行除去() '飛び期間の空行を詰めて表示する。
Dim x As long, i As long, k As long, max_motosu As long, motosu As long
saikeisanoff
Sheets("最後当選").Select
Range("kh1:lx1").ClearContents
Range("kh3:lx1200").ClearContents
For x = 1 To 43
i = 0: k = 0
Do Until Cells(3 + i, 3) = ""
If Cells(3 + i, 248 + x) <> "" Then
Cells(3 + i - k, 293 + x).Value = Cells(3 + i, 248 + x).Value
Cells(1, 293 + x).Value = Cells(1, 293 + x).Value + 1
Else
k = k + 1
End If
If i = 5000 Then Exit Do
i = i + 1
Loop
Next x
Cells(1, 293) = "=MAX(KH1:LX1)"
max_motosu = Cells(1, 293)
For x = 1 To 43
motosu = Cells(1, 293 + x)
If max_motosu > motosu Then
Range(Cells(3, 293 + x), Cells(max_motosu - motosu + 2, 293 + x)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next x
saikeisanon
Range(Cells(3, 294), Cells(2 + max_motosu, 336)).Select
Selection.Copy
Sheets("当選間抽選").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("ih1").Select
Sheets("当選間抽選").Select
Range("pu3:pu45").Select
Selection.Copy
Range("pq3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("pq3").Select
If i = 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
End Sub
--------------------------------------------------------------------------------------
前回の番号と今回の番号での前後の関係
Sub zengo_suuji_mu() ’前後の数字の集計（例43の前は42、後は1。1の前43、後は2）
Dim g As long, i As long, ii As long, jikunum As long, kaigou As long
Sheets("最後当選").Select
kaigou = Cells(1, 1)
Range(Cells(3, 2), Cells(3 + kaigou, 8)).Select
Selection.Copy
Sheets("前後数字").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P6:P48,S6:S48").Select ’集計セルのクリア
Selection.ClearContents
saikeisanoff ’再計算を止めて処理スピードアップさせる
g = 0
Do Until Cells(6 + g, 1) = ""
For i = 1 To 7
jikunum = Cells(5 + g, i) ’前の数字を読み込む
For ii = 1 To 7 ’後の数字を読み込み以下の処理をする。
If jikunum = 1 Then '前の番号1で
If Cells(6 + g, ii) - jikunum = 1 Then '後の番号2の時
Cells(6, 19) = Cells(6, 19) + 1 ’該当したら集計する
ElseIf Cells(6 + g, ii) - jikunum = 42 Then '後の番号43の時
Cells(6, 16) = Cells(6, 16) + 1 ’該当したら集計する
End If
ElseIf jikunum = 43 Then '前の番号43で
If Cells(6 + g, ii) - jikunum = -42 Then '後の番号1の時
Cells(48, 19) = Cells(48, 19) + 1 ’該当したら集計する
ElseIf Cells(6 + g, ii) - jikunum = -1 Then '後の番号42の時
Cells(48, 16) = Cells(48, 16) + 1 ’該当したら集計する
End If
Else '前の番号1あるいは43以外の時
If Cells(6 + g, ii) - jikunum = -1 Then
Cells(jikunum + 5, 16) = Cells(jikunum + 5, 16) + 1
ElseIf Cells(6 + g, ii) - jikunum = 1 Then
Cells(jikunum + 5, 19) = Cells(jikunum + 5, 19) + 1
End If
End If
Next ii
Next i
g = g + 1 ’1行づつ処理するためのカウンター計算
Loop
saikeisanon ’再計算をさせる
End Sub