趣味のエクセルマクロ

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

2.LOTO6SLJ 

ロト6において、第1の番号と残りの6つの番号の組み合わせを集計します。同じように
第2の番号と残りの5つ、第3、第4、第5、第6も同じようにします。
出目に対応したセルを作っておいてそこで計算と出力してます。


Sub 同伴数字()'ロト6で何と何が一緒に出ているのか?集計する。
Dim i, kaigo As Integer
   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, ii, iii, countre As Integer
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("aa1").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, i, k, max_motosu, motosu As Integer
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, i, ii, jikunum, kaigou As Integer
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