趣味のエクセルマクロ

ナンバーズ4などの数字選択式宝くじデータ分析用の自作マクロおよびナンバーズ4の各種データリストなどをブログにしています。

1.LOTO6SLJ

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
---------------------------------------------------------------------------------------------


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 Integer
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
--------------------------------------------------------------------------------------

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
--------------------------------------------------------------------------------------