趣味のエクセルマクロ&数字選択式宝くじ

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

2.LOTO6

Sub c_and_s() '第一数字から小さい順にソート、(自動マクロ記録で作成)
kaigo = Sheets("元データ").Cells(1, 38)
 Sheets("表 (2)").Select
  Range(Cells(2, 1), Cells(2 + kaigo, 9)).Select
  Selection.Copy
  Sheets("リスト1").Select
  Range("A2").Select
  ActiveSheet.Paste
  Range("C10").Select
  Sheets("元データ").Select
  Range(Cells(2, 12), Cells(2 + kaigo, 12)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("リスト1").Select
  Range("J2").Select
  ActiveSheet.Paste
   Range(Cells(2, 1), Cells(2 + kaigo, 10)).Select
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2 + kaigo, 2)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(2 + kaigo, 3)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(2 + kaigo, 4)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(2 + kaigo, 5)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(2 + kaigo, 6)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(2 + kaigo, 7)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 8), Cells(2 + kaigo, 8)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("リスト1").Sort
      .SetRange Range(Cells(2, 1), Cells(2 + kaigo, 10))
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With 
End Sub
-----------------------------------------------------------------------------------------------------

データを小さい順にソートすることにより出現状況が把握出来る。


Sub c_and_s2() ’パターン表もソートする 自動記録マクロ 一部修正
  kaigo = Sheets("元データ").Cells(1, 38)
  Sheets("分析 (2)").Select
Range(Cells(2, 1), Cells(2 + kaigo, 59)).Select
  Selection.Copy
  Sheets("リスト2").Select
   Range("A2").Select
  ActiveSheet.Paste 
    Range(Cells(2, 1), Cells(2 + kaigo, 59)).Select
  Application.CutCopyMode = False
  ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2 + kaigo, 2)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(2 + kaigo, 3)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(2 + kaigo, 4)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(2 + kaigo, 5)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(2 + kaigo, 6)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(2 + kaigo, 7)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 8), Cells(2 + kaigo, 8)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("リスト2").Sort
      .SetRange Range(Cells(2, 1), Cells(2 + kaigo, 59))
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
    Range(Cells(2, 10), Cells(2 + kaigo, 52)).Select
   Selection.Font.Underline = xlUnderlineStyleSingle
   Selection.Font.Underline = xlUnderlineStyleNone
  With Selection.Font
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
  End With
  Range("A1").Select
End Sub
-----------------------------------------------------------------------------------------------------
Sub 表へ() ’シートから別のシート(表へ)に移動する。
 Sheets("表").Select
End Sub


Sub 分析2へ()
 Sheets("分析 (2)").Select
End Sub


Sub 表2へ()
 Sheets("表 (2)").Select
End Sub


Sub 元データへ()
 Sheets("元データ").Select
End Sub


Sub リスト1へ()
 Sheets("リスト1").Select
End Sub
-----------------------------------------------------------------------------------------------------

'星座にナンバリングするマクロ関数 fxに計算式表示される
Function set_NUFseiza(arg_seizaNum As String) As Integer
Dim seiza As Integer
seiza = 0
  If arg_seizaNum = "牡羊座" Then seiza = 1
  If arg_seizaNum = "牡牛座" Then seiza = 2
  If arg_seizaNum = "双子座" Then seiza = 3
  If arg_seizaNum = "蟹座" Then seiza = 4
  If arg_seizaNum = "獅子座" Then seiza = 5
  If arg_seizaNum = "乙女座" Then seiza = 6
  If arg_seizaNum = "天秤座" Then seiza = 7
  If arg_seizaNum = "蠍座" Then seiza = 8
  If arg_seizaNum = "射手座" Then seiza = 9
  If arg_seizaNum = "山羊座" Then seiza = 10
  If arg_seizaNum = "水瓶座" Then seiza = 11
  If arg_seizaNum = "魚座" Then seiza = 12                 
  set_NUFseiza = seiza'星座を1から12にセルに表示する
End Function
-------------------------------------------------------------------------------------------------------


Sub Seiza_total() '星座毎に集計 
Dim kai, i, y, x, h As Integer
Sheets("元データ").Select
Range("DF4:DQ46").Select
   Selection.ClearContents
Range("DF50:DQ50").Select
   Selection.ClearContents  
kai = Cells(1, 38) - 1
saikeisanoff
For h = 0 To kai
For i = 1 To 7
  y = Cells(2 + h, i + 3) '1番目~7番目の出目
  x = Cells(2 + h, 20) + 109 '星座タイプ番号
  Cells(y + 3, x) = Cells(y + 3, x) + 1 '集計して出力
Next i
    Cells(50, x) = Cells(50, x) + 1 '星座集計して出力
Next h
    Range("DB1").Select
 saikeisanon
End Sub
-------------------------------------------------------------------------------------------------------


Sub tajyuucopy() '多重当選の計算する。


 Sheets("分析 (2)").Select
 Range("BJ2:CZ1500").Select
    Selection.ClearContents
  
       saikeisanoff


 For n = 1 To 43
  
i = 1
  Do Until Cells(i + 1, 5) = ""
     
     If Cells(i + 1, 9 + n) <> "" Then
          Cells(i + 1, 61 + n) = 1
     End If
  
    If i = 1500 Then Exit Do'1500回まではマクロ実行可能 それ以外はエラーになる
     i = i + 1
  Loop


 Next n


 For m = 1 To 43


i = 1
  Do Until Cells(i + 1, 5) = ""
   
     If Cells(i + 1, 61 + m) >= 1 Then '多重カウントする。
               If Cells(i + 2, 61 + m) = 1 Then
              Cells(i + 2, 61 + m) = Cells(i + 1, 61 + m) + 1
              Cells(i + 1, 61 + m) = ""
              End If
     End If
  
    If i = 1500 Then Exit Do
     i = i + 1
  
  Loop


 Next m


Cells(i, 2).Select
   
  saikeisanon
  
End Sub
---------------------------------------------------------------------------
Sub tajyupatacopy()
 ' 多重集計用コピーをする
Dim gyou As Integer
 gyou = ActiveCell.Row
     Range(Cells(gyou, 10), Cells(gyou, 52)).Select


  Selection.Copy
   Sheets("分析 (2)").Select
 Range(Cells(gyou + 1, 62), Cells(gyou + 1, 62)).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Application.CutCopyMode = False
   Cells(gyou, 1).Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub 挿入準備() 'データ挿入行の準備
gyou = ActiveCell.Row
     Sheets("リスト1").Select
   Rows(gyou).Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Sheets("リスト2").Select
   Rows(gyou).Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Sheets("リスト1").Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub mi_toutalgo()
 i = 1
 Do Until Cells(i, 53) = ""
   If i = 1000 Then Exit Do
    i = i + 1
 Loop
 Cells(i, 53).Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub first_検索()
Dim gyou, nunban, nextbango As Integer
 Range("c2:c1000").Select
 bango = Application.InputBox("最初の番号は何番ですか ")
   Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, MatchByte:=False, SearchFormat:=False).Activate
 gyou = ActiveCell.Row


 caunter = Application.CountIf(Range(Cells(gyou, 3), Cells(gyou + 100, 3)), bango) - 1


 nextbango = Application.InputBox("二番目の番号は何番ですか ")
If bango >= nextbango Then MsgBox "データ等をチェックして下さい。": End
     Range(Cells(gyou + 1, 62), Cells(gyou + 1, 62)).Select
   Selection.Find(What:=nextbango, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , MatchByte:=False, SearchFormat:=False).Activate
 End Sub
-----------------------------------------------------------------------------------------------------

1.LOTO6

'マクロ実行-------表示パターン選択-------パターンで表示する
Public pata_1, pata_2 As String
Public pata_f As Integer
Dim hit(1100, 7) As Integer
Dim retu As Integer
Dim gyou As Integer
Dim carahan As Object
Dim carahani As Object
--------------------------------------------------------------------------------------------------
Sub patapata() 'ロト6当選数字パターン(6種類から選択)貼付け
 saikeisanoff ’再計算を止めて処理スピードアップする。
Erase hit: pata_1 = "": pata_2 = "": pata_f = 0
UserForm1.Show 'ユーザーホームを開くーーパターン選択
Call syoukyo ’データ消去サブプログラム呼び出し
   actsheet = ActiveSheet.Name
If actsheet <> "リスト2" Then '元データをコピーする。
Sheets("元データ").Select
Range("d2:k1100").Select
Selection.Copy
Sheets(actsheet).Select
Range("b2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
End If
  i = 2
Do Until Cells(i, 2) = "" ’データが無くなる迄下の処理をする
For j = 1 To 7
      If Cells(i, j + 1) <= 0 Or Cells(i, j + 1) >= 44 Then MsgBox i - 1 & "回のデータが不正です": End
     hit(i - 1, j) = Cells(i, j + 1)
     If j > 1 And j < 7 And hit(i - 1, j - 1) >= hit(i - 1, j) Then MsgBox i - 1 & "回のデータが不正です": End     
Next j 
If i = 1500 Then Exit Do
  i = i + 1
k = i
Loop
For i = 1 To k - 2
     For j = 1 To 7
      If pata_f = 1 Then
         If j = 7 Then
          Cells(i + 1, 9 + hit(i, j)) = 0 '"○"
         Else         
          Cells(i + 1, 9 + hit(i, j)) = hit(i, j)
         End If
     Else
        If j = 7 Then pata = pata_1 Else pata = pata_2   
       If hit(i, j) > 0 Then      
         Cells(i + 1, 9 + hit(i, j)) = pata        
        End If
      End If
    Next j
  Next i
Range("J2:AZ1100").Select
Range("J1:r1100,ac1:Al1000,Aw1:AZ1000").Select
Range("Aw1").Activate
Call renpata '連番数字  サブマクロプログラム
Cells(i + 1, 9).Select
 saikeisanon’再計算をする。
End Sub
--------------------------------------------------------------------------------------------------
Sub renpata() '連番数字  サブマクロプログラム
Columns("B:G").Select
  Selection.Interior.ColorIndex = xlNone
i = 2
Do Until Cells(i, 2) = ""
For j = 6 To 2 Step -1    
If hit(i - 1, j) - hit(i - 1, j - 1) = 1 Then '連番部を緑色に塗りつぶす
  karaiti = Cells(i, j) + 9
Set carahan = Application.Union(Range(Cells(i, j), Cells(i, j + 1)), Range(Cells(i, karaiti), Cells(i, karaiti + 1))) 
  carahan.Interior.ColorIndex = 35
End If  
Next j  
If hit(i - 1, 1) = 1 And hit(i - 1, 6) = 43 Then '1,43の連番部を緑色に塗りつぶす
  Set carahani = Application.Union(Cells(i, 2), Cells(i, 7), Cells(i, 10), Cells(i, 52))
   carahani.Interior.ColorIndex = 35
End If                  
  If i = 1100 Then Exit Do
    i = i + 1 
Loop
End Sub
'------------------------------------------------------------------------
Sub syoukyo()’データ消去サブプログラム
Range("J2:AZ1000").Select
Selection.ClearContents

Range("J2").Select
End Sub
'------------------------------------------------------------------------
Sub filter()
For ff = 1 To 59
       Selection.AutoFilter Field:=ff
Next ff
Range("a2").Select
     z = 1
Do Until Cells(1 + z, 1) = ""
     z = z + 1
Loop
  Cells(z + 1, 1).Select
End Sub
'------------------------------------------------------------------------
Sub 予想番号貼付け()
   Dim gyou As Integer
   Dim yosouhitnmb(6) As Integer
   gyou = ActiveCell.Row
If Cells(gyou, 1) > 0 Then MsgBox "過去の当選番号欄です。": End
j = 0
For i = 1 To 43
     If Cells(gyou, i + 9) <> "" Then
       If i - j > 6 Then MsgBox "データ数がおかしいです。": End
       yosouhitnmb(i - j) = i
    Else
          j = j + 1
   End If
Next
For j = 1 To 6
If yosouhitnmb(j) > 0 Then
   Cells(gyou, j + 1) = yosouhitnmb(j)
   If Cells(gyou, 7) = 0 Then
      Cells(gyou, 7) = 1    
   End If
Else
   MsgBox "データ等をチェックして下さい。": End
End If
Next j
     Range(Cells(gyou, 2), Cells(gyou, 7)).Select
    Selection.Insert Shift:=xlDown
z = 1
Do Until Cells(gyou + z, 2) = ""
    z = z + 1
Loop
Cells(gyou + 1, 8) = z - 1
End Sub
--------------------------------------------------------------------------------------------------


Sub rencunters() '連荘パターン集計
   retu = ActiveCell.Column
   gyou = ActiveCell.Row  
   i = 0
Do Until Cells(gyou + i, retu) = ""     
    If Cells(gyou + i, retu) <> 0 Then
      Cells(gyou + i, retu + 1) = k + 1
        k = k + 1
         If Cells(gyou + i + 1, retu) = 0 Then
            rentyan = k: k = 0
            Cells(gyou + i, retu + 2) = rentyan '連荘合計
         End If
    End If
   If i = 5000 Then Exit Do
      i = i + 1     
Loop
   If i = 0 Then MsgBox "データ等をチェックして下さい。": End  
End Sub
'------------------------------------------------------------------------
Sub r_input()
Application.MoveAfterReturnDirection = xlToRight
End Sub
'------------------------------------------------------------------------
Sub d_input()
Application.MoveAfterReturnDirection = xlDown
End Sub
'------------------------------------------------------------------------
Sub 再罫線()
Range("A1:AZ307").Select
With Selection.Borders(xlLeft)
     .Weight = xlThin
     .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlRight)
     .Weight = xlThin
     .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlTop)
     .Weight = xlThin
     .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlBottom)
     .Weight = xlThin
     .ColorIndex = xlAutomatic
End With
Selection.BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic


Range("A1").Select
End Sub
'------------------------------------------------------------------------
Sub 当選番号チェック()
Dim retu As Integer
retu = ActiveCell.Column
no = Application.InputBox("当選数字は", Type:=1)
i = 3
Do Until Cells(i, retu) = ""
For j = 1 To 6  
If Cells(i, retu - 1 + j) = no Then   
    Cells(i, retu - 1 + j).Select
     Selection.Font.ColorIndex = 3 '赤   
ElseIf Cells(i, retu - 1 + j) = no + 1 Then
   If Cells(i, retu - 2 + j) <> no Then
       Cells(i, retu - 1 + j).Select
       Selection.Font.ColorIndex = 7 '黒
   End If
  ElseIf Cells(i, retu - 1 + j) = no - 1 Then
     Cells(i, retu - 1 + j).Select
     Selection.Font.ColorIndex = 7 '紫      
End If
Next j
    i = i + 1
Loop
Cells(3, retu).Select


End Sub
'------------------------------------------------------------------------


Sub cunters()
 Dim retu As Integer
 Dim gyou As Integer

retu = ActiveCell.Column
gyou = ActiveCell.Row


i = 0
Do Until Cells(gyou + i, retu - 1) = "" And Cells(gyou + i, retu) = "" 
  If Cells(gyou + i, retu) = "" Then


       Cells(gyou + i, retu) = k + 1
      k = k + 1
     If Cells(gyou + i + 1, retu) <> "" Then k = 0 
  End If
If i = 2000 Then Exit Do
  i = i + 1 
Loop
End Sub
--------------------------------------------------------------------------------------------------

Sub dayplus6()’日付を追加する--月曜&木曜
   gyou = ActiveCell.Row
   Cells(gyou - 1, 3).Copy Cells(gyou, 3)
   Cells(gyou, 3) = Cells(gyou, 3) + 4
 Cells(gyou + 1, 3) = Cells(gyou, 3) + 3
End Sub


--------------------------------------------------------------------------------------------------


Sub rotos() 'クイックピック
   saikeisanoff
Randomize
  Range("a1:b43").Select
  Selection.ClearContents 
   count_6 = 0
  Add = Int(Rnd() * 43) + 1
For i = 1 To 400 + Add
     kai = Int(Rnd() * 43) + 1 
     Cells(kai, 1) = kai
  If Cells(kai, 1) > 0 Then
    ran = Int(Rnd() * 100) + 1
    Cells(kai, 2) = ran ' Cells(kai, 2) + 1
  End If
  Range("c1") = "=count(a1:a43)"
Next i
Range("B1").Select
ActiveWorkbook.Worksheets("QP").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("QP").Sort.SortFields.Add Key:=Range("B1"), _
     SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
     xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("QP").Sort
     .SetRange Range("A1:C43")
     .Header = xlNo
     .MatchCase = False
     .Orientation = xlTopToBottom
     .SortMethod = xlPinYin
     .Apply
End With
Range("A1:B6").Select
ActiveWorkbook.Worksheets("QP").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("QP").Sort.SortFields.Add Key:=Range("A1"), _
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
     xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("QP").Sort
     .SetRange Range("A1:B6")
     .Header = xlNo
     .MatchCase = False
     .Orientation = xlTopToBottom
     .SortMethod = xlPinYin
     .Apply
End With
Columns("B:B").Select
Selection.ClearContents
Range("A7:A43").Select
Selection.ClearContents
Range("A1:A6").Select
Selection.Copy
Range("G15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=True
Application.CutCopyMode = False
Selection.Copy
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
Application.CutCopyMode = False
saikeisanon
End Sub
--------------------------------------------------------------------------------------------------                
Sub saikeisanoff()
With Application
         .Calculation = xlManual
         .MaxChange = 0.001
     End With
     ActiveWorkbook.PrecisionAsDisplayed = False            
End Sub
---------------------------
Sub saikeisanon()
  With Application
         .Calculation = xlAutomatic
         .MaxChange = 0.001
     End With
     ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
--------------------------------------------------------------------------------------------------                

Sub hotno_sin() ’ホットナンバー(目視で判別する)を赤色にする。複数シートを同時に
Dim maruiti As Object
   Sheets("表").Select
    retu = ActiveCell.Column
    gyou = ActiveCell.Row
  Set maruiti = Application.Cells(gyou, retu)
      maruiti.Font.Underline = xlUnderlineStyleSingle
     maruiti.Font.ColorIndex = 3 
Sheets("分析 (2)").Select
   Set maruiti = Application.Cells(gyou, retu)
   maruiti.Font.Underline = xlUnderlineStyleSingle
   maruiti.Font.ColorIndex = 3
Sheets("表 (2)").Select
   Set maruiti = Application.Cells(gyou, retu)
   maruiti.Font.Underline = xlUnderlineStyleSingle
   maruiti.Font.ColorIndex = 3
Sheets("表").Select
  Cells(gyou + 1, retu).Select
    j = 1
If Cells(gyou + j, retu) = "" Then 
   Do Until Cells(gyou + j, retu) <> ""    
       If j > 3 Then Exit Do
        j = j + 1
   Loop
   Cells(gyou + j, retu).Select   
End If
End Sub
--------------------------------------------------------------------------------------------------


Sub B_H() 'ブラックホール(ボーナス数字含むとする) 手動指定場所を塗りつぶす。
  With Selection.Interior
     .Pattern = xlSolid
     .PatternColorIndex = xlAutomatic
     .ThemeColor = xlThemeColorDark1
     .TintAndShade = -0.149998474074526
     .PatternTintAndShade = 0
End With
End Sub
--------------------------------------------------------------------------------------------------

2.miniloto


前回の数字に.対して次回に出た各数字(ペア)の累計 ボーナス数字含む



Sub after_32no() '後追い数字  緑色は平均より出ている
Dim i, ii, iii, countre, xa, ya As Integer
Sheets("元データ").Select
countre = Cells(1, 31)
Range("B2:g1500").Select
Selection.Copy
Sheets("後追数字").Select
Range("A1").Select
ActiveSheet.Paste
Range("l4:ap34") = 0
i = 0: ii = 0: iii = 0
   saikeisanoff
For i = 2 To countre
  For ii = 1 To 6
      xa = Cells(i - 1, ii) '最初数字1,1
   For iii = 1 To 6
      ya = Cells(i, iii)  '次回以降数字1,2
      Cells(3 + ya, 11 + xa) = Cells(3 + ya, 11 + xa) + 1
   Next iii
 Next ii
Next i
   Cells(2, 28) = "=max(AB4:AB46)"
saikeisanon
  Cells(1, 9) = countre & "回"
 Range("l4:ap34").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
Range("i1").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 行挿入()
gyou = ActiveCell.Row
    Rows(gyou).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("リスト2").Select
Rows(gyou).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
---------------------------------
Sub 入力行へ()
gyou = Cells(1, 31) + 2
Range(Cells(gyou, 2), Cells(gyou, 9)).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub c_and_s() '昇順にソートする。マクロの自動記録で作成、範囲部を修正
 kaigo = Sheets("元データ").Cells(1, 31) + 1’最終回号
 Sheets("分析 (3)").Select
Range(Cells(2, 1), Cells(kaigo, 9)).Select
Selection.Copy
Sheets("リスト1").Select
  Range("A2").Select
ActiveSheet.Paste
Range(Cells(2, 1), Cells(kaigo, 9)).Select 
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range("B2:B868" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(kaigo, 2) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(kaigo, 3) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(kaigo, 4) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(kaigo, 5) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(kaigo, 6) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(kaigo, 7) _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("リスト1").Sort
 .SetRange Range(Cells(2, 1), Cells(kaigo, 9))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub C_and_s2() '昇順にソートする。
kaigo = Sheets("元データ").Cells(1, 31) + 1 ’最終回号
Sheets("分析 (3)").Select
Range(Cells(2, 1), Cells(kaigo, 50)).Select
Selection.Copy
  Sheets("リスト2").Select
Range("A2").Select
ActiveSheet.Paste
Range(Cells(2, 10), Cells(kaigo, 40)).Select
With Selection.Font
     .ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Underline = xlUnderlineStyleNone
Range(Cells(2, 1), Cells(kaigo, 50)).Select
Application.CutCopyMode = False
  ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(kaigo, 2)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(kaigo, 3)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(kaigo, 4)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(kaigo, 5)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(kaigo, 6)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(kaigo, 7)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("リスト2").Sort
'.SetRange Range("A2:AX918")
.SetRange Range(Cells(2, 1), Cells(kaigo, 50))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub B_H()
  With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End Sub