1.LOTO6SLJ
ロト6の各パターン分析
記事目次 ロト・ビンゴ
1~43の当選番号の当選間隔表示
Sub 最後当選へコピー()
'ファイル LOTO6からファイルLOTO6SlJ.xlsmのシート(最後の当選)にコピーする。
(LOTO6.xlsmのシート表 (2)の.最新当選1106回のみ)
gyou = Windows("LOTO6SlJ.xlsm").ActiveCell.Row '当選回を選択しておき
If Cells(gyou, 2) <> "" And Cells(gyou, 4) <> "" Then End
Windows("LOTO6.xlsm").Activate
Sheets("表 (2)").Select
Range(Cells(gyou - 1, 1), Cells(gyou - 1, 52)).Select
Selection.Copy
Windows("LOTO6SlJ.xlsm").Activate
Sheets("最後当選").Select
Cells(gyou, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call 飛び記入_6 ’サブルーチン(間隔集計)呼び出し
Range("BA3").Select
Selection.Copy
Cells(gyou, 53).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(gyou, 3).Select
End Sub
--------------------------------------------------------------------------------------
休んだ後の当選状況
Sub 飛び記入_6() 'サブルーチン(間隔集計)
retu = ActiveCell.Column
gyou = ActiveCell.Row
For i = 0 To 42
If Cells(gyou - 1, 10 + i) = "●" Or Cells(gyou - 1, 10 + i) = "○" Then
If Cells(gyou, 10 + i) = "" Then Cells(gyou, 10 + i) = 1
Else ’前回の間隔に+1する。
If Cells(gyou, 10 + i) = "" Then Cells(gyou, 10 + i) = Cells(gyou - 1, 10 + i) + 1
End If
Next i
End Sub
--------------------------------------------------------------------------------------
Sub 飛び期間へコピー()
'最後の当選から最新当選回を飛び機関へコピーする。
j = 0
Sheets("最後当選").Select
gyou = Windows("LOTO6SlJ.xlsm").ActiveCell.Row
Range(Cells(gyou, 10), Cells(gyou, 52)).Select
Selection.Copy
Sheets("飛び期間").Select
Cells(gyou, 39).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For i = 0 To 42
If Cells(gyou, 39 + i) <> "●" Then
If Cells(gyou - 1, 39 + i) = "●" Then
Cells(gyou, 39 + i) = 1
Else
Cells(gyou, 39 + i) = Cells(gyou - 1, 39 + i) + 1
End If
Else '当選番号記入する。
Cells(gyou, 5 + j) = Cells(2, 39 + i)
'はずれ間隔記入する。
hazu = Cells(gyou, 83 + i)
If hazu <= 9 Then hazu = "0" & hazu
Cells(gyou, 17 + j) = hazu
j = j + 2
End If
Next i
Range(Cells(gyou - 1, 29), Cells(gyou - 1, 31)).Select
Application.CutCopyMode = False
Selection.Copy
Cells(gyou, 29).Select
ActiveSheet.Paste
End Sub
--------------------------------------------------------------------------------------
任意に分けた範囲での当選状況
Sub 偏りへコピー() ’ボーナス数字を除いた6個
Sheets("最後当選").Select
gyou = ActiveCell.Row
Range(Cells(gyou, 2), Cells(gyou, 7)).Select
Selection.Copy
Sheets("偏り追跡").Select
Range("R1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
---------------------------------------------------------------------------------------------
星座別の出現状況集計
マクロ作成方法13(自動記録・コピー) - 趣味のエクセルで当てようロト・ナンバーズ
Sub copiii() '占星術コピイ
Windows("LOTO6.xlsm").Activate
Sheets("元データ").Select
Range("DF4:DQ50").Select
Selection.Copy
Windows("LOTO6SlJ.xlsm").Activate
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C9:N51").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
ActiveWindow.SmallScroll Down:=-12
Range("B2").Select
End Sub
--------------------------------------------------------------------------------------
Sub ハズレ()
Sheets("当選間抽選").Select
Range("CA3:CA45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("飛後当選").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A15").Select
End Sub
--------------------------------------------------------------------------------------
Sub toukeitiran()
Sheets("統計一覧").Select
Range("L6:L48").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M6:O48").Select
Application.CutCopyMode = False
Selection.Copy
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P6:P48").Select
Application.CutCopyMode = False
Selection.Copy
Range("I6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K2").Select
End Sub
--------------------------------------------------------------------------------------
Sub zengo_suujicopy()
Range("V6:V48").Select
Selection.Copy
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O6").Select
Application.CutCopyMode = False
End Sub
--------------------------------------------------------------------------------------
Sub tobgonotousen()
Sheets("飛後当選").Select
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("最後当選").Select
Range("EX3:GN37").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Sheets("飛後当選").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("A4:A46").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("H1").Select
End Sub
--------------------------------------------------------------------------------------
前回から継続して当選した出目状況
Sub 多重当選()
Windows("LOTO6.xlsm").Activate
Sheets("分析 (2)").Select
Range("dh4:ex9").Select
Selection.Copy
Windows("LOTO6slj.xlsm").Activate
Sheets("多重当選").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("LOTO6.xlsm").Activate
Range("B2").Select
Windows("LOTO6slj.xlsm").Activate
End Sub
-------------------------------------------------------------------------------------
Sub ryakusiki()
retu = ActiveCell.Column
If Cells(4, retu) <> "" Then End
Sheets("当選間抽選").Select
Range("pz3:pz45").Select
Selection.Copy
Sheets("略式最後").Select
Range(Cells(4, retu), Cells(4, retu)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(4, retu), Cells(46, retu)).Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("bif4:bif46").Select
Selection.Copy
Range("bid4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
bango = Sheets("最後当選").Cells(1, 4)
Cells(3 + bango, retu).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Cells(4, retu).Select
End Sub
-----------------------------
Sub saikeisanoff()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False '画面変更をしない。
End Sub
-------------------------------
Sub saikeisanon()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
Application.ScreenUpdating = True '画面変更
End Sub
------------------------------------------------------------------------------------
Sub last_tousenkan()
Sheets("最後当選").Select
gyou = ActiveCell.Row
res = MsgBox(gyou - 2 & "回を当選間抽選シートへコピーしますか", vbYesNo)
If res = vbYes Then
Range(Cells(gyou - 1, 10), Cells(gyou, 52)).Select
Else
End
End If
Selection.Copy
Sheets("当選間抽選").Select
Range("px3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
--------------------------------------------------------------------------------------
Sub 回までコピー()
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
End Sub
--------------------------------------------------------------------------------------
連番(隣同志)当選番号の累計状況
Sub tousen_No() '隣同士の番号に*印する。
Dim gyou As long
saikeisanoff
Sheets("となり組").Range(Cells(1, 15), Cells(2, 24)).Clear
Sheets("最後当選").Select
gyou = ActiveCell.Row
Range(Cells(gyou - 1, 2), Cells(gyou - 1, 8)).Select
Selection.Copy
Sheets("となり組").Select
Cells(2, 15).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(2, 23) = Cells(2, 21)
Cells(1, 23) = "ボ"
Range("O2:U2").Select
With ActiveWorkbook.Worksheets("となり組").Sort
.SetRange Range("O2:U2")
.SortMethod = xlPinYin
.Apply
End With
For i = 1 To 6
If Cells(2, 14 + i) - Cells(2, 15 + i) = -1 Then
Cells(1, 14 + i) = "*"
Cells(1, 15 + i) = "*"
End If
Next i
If Cells(2, 15) = 1 And Cells(2, 21) = 43 Then
Cells(1, 15) = "*": Cells(1, 21) = "*"
End If
Range("O1:W2").Select
With Selection
.HorizontalAlignment = xlCenter
End With
saikeisanon
Cells(1, 8).Select
End Sub
--------------------------------------------------------------------------------------
Sub 転記() '偏りをR列に転記、それを元に関数で●の数で表示する
retu = ActiveCell.Column
gyou = ActiveCell.Row
tennkgyo = Cells(gyou, retu) + 2
Range(Cells(gyou + 1, retu), Cells(gyou + 6, retu)).Select
Application.CutCopyMode = False
Selection.Copy
Cells(tennkgyo, 18).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
--------------------------------------------------------------------------------------
Sub lastplace()
beplace = Cells(1, 19) + 3
Cells(beplace, 2).Select
End Sub
--------------------------------------------------------------------------------------
6つの本当選番号(ボーナス番号除く)の合計推移
Sub grf_copy() ’合計132を中心として合計を表示
Sheets("合計偏り").Select
gyou = ActiveCell.Row
gokei = Cells(gyou, 2)
i = 1
Do Until gokei = Cells(gyou - i, 2) ’同じ合計が有る場合コピーする。
i = i + 1
If gyou - i = 2 Then Exit Do
Cells(gyou - i, 2).Select
Loop
If gokei <> Cells(gyou - i, 2) Then End
Range(Cells(gyou - i, 3), Cells(gyou - i, 17)).Select
Selection.Copy
Cells(gyou, 3).Select
ActiveSheet.Paste
Cells(gyou, 2).Select
End Sub
--------------------------------------------------------------------------------------