趣味のエクセルマクロ

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

2.N4ST分析

ナンバーズ4ストレート分析

 Sub next_total() '次合計を表示する
Dim kai As Integer
kai = Sheets("ストレートパターン").Cells(2, 15)
Sheets("次数字").Select
Range("jj12:kt6000").ClearContents '出力表示部のクリア
  Sheets("ストレートパターン").Select
Range(Cells(4, 15), Cells(kai + 3, 15)).Select
Selection.Copy
Sheets("次数字").Select
Range("ji13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call saikeisanoff '再計算を止めて計算を速くする
Application.ScreenUpdating = False '画面変更オフ
i = 13: k = 1
Do Until Cells(i, 269) = ""
retu_1 = Cells(i, 269).Value + 271
nextotal = Cells(i + 1, 269)
 caunter = Application.Count(Range(Cells(13, retu_1), Cells(500, retu_1))) + 1
 Cells(9, retu_1) = caunter
Cells(caunter + 12, retu_1) = nextotal
i = i + 1
   If i = 5001 Then Exit Do
Loop
Application.ScreenUpdating = True '画面変更オン
Call saikeisanon '再計算をオンにする
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub nextotal_seiretu()   '番号,回号、間隔を下並び出力。
Dim gokei_max, kigu_max, daisyo_max, mini_pmax, mini_smax As Integer
Dim i, ii, j, jj, k, start As Integer
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
   Call saikeisanoff '再計算を止めて計算を速くする
gokei_max = Cells(9, 270)
For i = 0 To 36
motosuu = Cells(9, i + 271)
  Range(Cells(12, i + 271), Cells(12 + motosuu, i + 271)).Select '番号
Selection.Cut
Cells(12 + gokei_max - motosuu, i + 271).Select
ActiveSheet.Paste
Next i
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub HotNo4_Seiretu()
 Sheets("ストレートパターン").Select
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Range("ex4:gk777").Clear '出力表示部のクリア
    Range("DB4:Eo462").Select
Application.CutCopyMode = False
Selection.Copy
   Range("Ex4").Select
ActiveSheet.Paste
For i = 1 To 40
Cells(2, i + 153) = Application.Count(Range(Cells(4, i + 153), Cells(800, i + 153)))
Next i
gokei4_max = Cells(1, 147) + 1
For j = 1 To 40
  motosuu = Cells(2, j + 153)
Range(Cells(4, j + 153), Cells(4 + motosuu, j + 153)).Select '番号
 Selection.Cut
Cells(4 + gokei4_max - motosuu, j + 153).Select
ActiveSheet.Paste
Next j
 yy = Cells(2, 15) + 3
Range(Cells(yy, 16), Cells(yy, 55)).Select
Application.CutCopyMode = False
Selection.Copy
Range("EX1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells(3 + gokei4_max, 169).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub nextsuuji_4keta_st() '桁別次数字を表示する
Dim retu_1, jisyyji, h, j, i As Integer
start = MsgBox("開始しますか?", vbYesNo)
If start = vbNo Then End
kai = Sheets("ストレートパターン").Cells(2, 15)
Range("df12:ew496").ClearContents '出力表示部のクリア
  Sheets("ストレートパターン").Select
Range(Cells(4, 4), Cells(kai + 3, 7)).Select
Selection.Copy
Sheets("次数字").Select
Range("df12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
 Call saikeisanoff '再計算を止めて計算を速くする
i = 12: caunter = 0
Do Until Cells(i, 110) = ""
For j = 1 To 4
  retu_1 = 0: jisyyji = 0
Select Case j 'データ表示列位置の設定
  Case 1:  span = 114: h = 0 '千桁
  Case 2:  span = 124: h = 1 '百桁
  Case 3:  span = 134: h = 2 '十桁
  Case 4:  span = 144: h = 3 '一桁
End Select
retu_1 = Cells(i, 110 + h).Value + span
jisyyji = Cells(i + 1, 110 + h)
   caunter = Application.Count(Range(Cells(12, retu_1), Cells(500, retu_1))) + 1
If jisyyji <> "" Then
Cells(10, retu_1) = caunter
End If
Cells(caunter + 11, retu_1) = jisyyji
Next j
i = i + 1
If i = kai + 30 Then Exit Do
Loop
Call saikeisanon '再計算をオンにする
 Range("et11").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub jyouken()
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(EX12,2)=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = 3
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=EX12>4"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub nextketa_Seiretu_st()
Sheets("次数字").Select
Range("dj12:ew700").Select
'Call jyouken
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
  keta_max = Cells(10, 113)
For j = 1 To 40
    motosuu = Cells(10, j + 113)
If keta_max <> motosuu Then
  Range(Cells(12, j + 113), Cells(12 + motosuu, j + 113)).Select '番号
'Stop
Selection.Cut
Cells(12 + keta_max - motosuu, j + 113).Select
ActiveSheet.Paste
' If j = 2 Then Exit For
End If
Next j
Cells(10 + keta_max, 133).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub pear_next_no()   'ペア数字の後の番号を出力6種類
Dim j, i, k, retu As Integer
j = 0
i = 4
k = 0
retu = 0
Sheets("次数字").Select
Range("a4:a4000").Copy
Range("bua4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
  Range("buj4:bwl4000").Select
Selection.ClearContents
Call saikeisanoff 
Do Until Cells(i, 1900) = ""
    For j = 1 To 6 '出目の入力348
d = Cells(i, j + 1899).Value
If d >= 11 And d <= 19 Then
k = -1
ElseIf d >= 22 And d <= 29 Then
k = -3
ElseIf d >= 33 And d <= 39 Then
k = -6
ElseIf d >= 44 And d <= 49 Then
k = -10
ElseIf d >= 55 And d <= 59 Then
k = -15
ElseIf d >= 66 And d <= 69 Then
k = -21
ElseIf d >= 77 And d <= 79 Then
k = -28
ElseIf d >= 88 And d <= 89 Then
k = -36
ElseIf d = 99 Then
k = -45
Else
k = 0
End If
retu = d + 1908 + k
If patann = 1 Then
 Cells(i, retu) = Cells(i, 15)
ElseIf patann = 2 Then
 Cells(i, retu) = Cells(i, j + 1899)
ElseIf patann = 3 Then
 Cells(i, retu) = Cells(i, 1899)
 End If
Next j
i = i + 1
    If i = 4001 Then Exit Do
Loop
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub stpear_suji()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を出力。現在間隔作成中
Dim j, k, i, n, caunter, maxx, setretu, span, writretu, kaigo As Integer
 Sheets("三桁分析").Select
 kaigo = Sheets("ストレートパターン").Cells(1, 56)
caunter = 0
  Range("aoo28:bql4000").ClearContents '出力表示部のクリア
Call saikeisanon
Range("aoh28").Select
Selection.NumberFormatLocal = "G/標準"
  Range("aoh28") = "=ストレートパターン!C4"
Range("aoi28") = "=ストレートパターン!H4"
Range("aoj28") = "=ストレートパターン!I4"
Range("aok28") = "=ストレートパターン!J4"
Range("aol28") = "=ストレートパターン!K4"
Range("aom28") = "=ストレートパターン!L4"
Range("aon28") = "=ストレートパターン!M4"
Range("aoh28:aon28").Copy Range(Cells(29, 1074), Cells(27 + kaigo, 1080))
Range(Cells(29, 1074), Cells(27 + kaigo, 1080)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call saikeisanoff '再計算を止めて計算を速くする
i = 28
Do Until Cells(i, 1075) = "" And Cells(i, 1077) = ""
 Cells(i, 1073) = i - 27
  For n = 1 To 6 '百十、百一、十一に分ける。
setretu = Cells(i, 1074 + n).Value '番号によりデータ記入位置を設定する。
      Select Case n '千百、千十、千一,百十,百一,十一のデータ表示列位置の設定
Case 1: span = 1082 '千百
Case 2: span = 1207 '千十
Case 3: span = 1332 '千一
Case 4: span = 1457 '百十
Case 5: span = 1582 '百一
Case 6: span = 1707 '十一
End Select
writretu = setretu + span
caunter = Application.CountA(Range(Cells(28, writretu), Cells(88, writretu)))    '記入位置をカウンタから計算する。   
  Cells(28 + caunter, writretu) = Cells(i, 1073)   '回号データを記入する。
  Cells(19, writretu) = kaigo - Cells(i, 1073)
If caunter = 0 Then '回号データの間隔を200行から記入する
  Cells(100 + caunter, writretu) = Cells(i, 1073)
Else
   Cells(100 + caunter, writretu) = Abs(Cells(27 + caunter, writretu) - Cells(28 + caunter, writretu))
End If
  Cells(200 + caunter, writretu) = Cells(i, 1074)    '番号データを200行から記入する
   Cells(20, writretu) = caunter + 1   '合計カウンタを計算表示する
   Cells(19, span - 1) = Application.Max(Range(Cells(19, span), Cells(19, span + 100)))
Cells(20, span - 1) = Application.Max(Range(Cells(20, span), Cells(20, span + 100)))
Next n
i = i + 1
If i = kaigo + 100 Then Exit Do
Loop
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub TKGM4_seiretu()   'stpear_sujiの番号,回号、間隔を下並び出力。
Dim degen_max, motosuu As Integer
Dim i, n, start As Integer
If Cells(28, 1082) = "" Then End
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Sheets("三桁分析").Select
Call saikeisanoff '再計算を止めて計算を速くする
Application.ScreenUpdating = False '画面変更をしない。
For n = 1 To 6 '百十、百一、十一に分ける。
  Select Case n '千百、千十、千一,百十,百一,十一のデータ表示列位置の設定1082-1806
   Case 1: span = 1082 '千百
   Case 2: span = 1207 '千十
   Case 3: span = 1332 '千一
   Case 4: span = 1457 '百十
   Case 5: span = 1582 '百一
   Case 6: span = 1707 '十一
End Select
  motosuu = 0
degen_max = Cells(20, span - 1)
For i = 0 To 99
motosuu = Cells(20, i + span)
Range(Cells(28, i + span), Cells(400, i + span)).Select '回号,間隔,番号
Selection.Cut
 Cells(28 + degen_max - motosuu, i + span).Select
 ActiveSheet.Paste
 Next i
Next n
Call saikeisanon '再計算を起動させる
Application.ScreenUpdating = True '画面変更on。
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub tripear_box()   'トリペア数字
Dim d(4), i, j, k, iti, caunter, reiti, loopend As Integer
   start = MsgBox("開始しますか?", vbYesNo)
If start = vbNo Then End

   kaigo = Sheets("ストレートパターン").Cells(2, 15)
loopend = kaigo + 33
j = 0
k = 0
iti = 0
Sheets("box分析").Select
Range("P12:ia12,P15:ia5000").ClearContents
Call saikeisanon
Range("b15") = "=SMALL(ストレートパターン!D4:G4,1) & SMALL(ストレートパターン!D4:G4,2) & SMALL(ストレートパターン!D4:G4,3) & SMALL(ストレートパターン!D4:G4,4)"
'Range("b15").Copy Range(Cells(16, 2), Cells(kaigo + 14, 2))
Cells(15, 2).Copy Range(Cells(16, 2), Cells(kaigo + 14, 2))
Range("P15").Activate
Call saikeisanoff
    caunter = 0
i = 15
     Do Until kaigo = i - 15
For j = 1 To 4 '出目の入力348
Select Case j
Case 1: d(j) = Left(Cells(i, 2), 3)
Case 2: d(j) = Left(Cells(i, 2), 2) & Right(Cells(i, 2), 1)
Case 3: d(j) = Left(Cells(i, 2), 1) & Right(Cells(i, 2), 2)
Case 4: d(j) = Right(Cells(i, 2), 3)
End Select
If d(j) >= 11 And d(j) <= 19 Then
k = -1
ElseIf d(j) >= 11 And d(j) <= 19 Then
k = -1
ElseIf d(j) >= 22 And d(j) <= 29 Then
k = -3
ElseIf d(j) >= 33 And d(j) <= 39 Then
k = -6
ElseIf d(j) >= 44 And d(j) <= 49 Then
k = -10
ElseIf d(j) >= 55 And d(j) <= 59 Then
k = -15
ElseIf d(j) >= 55 And d(j) <= 59 Then
k = -15
ElseIf d(j) >= 66 And d(j) <= 69 Then
k = -21
ElseIf d(j) >= 77 And d(j) <= 79 Then
k = -28
ElseIf d(j) >= 88 And d(j) <= 89 Then
k = -36
ElseIf d(j) = 99 Then
k = -45
ElseIf d(j) >= 111 And d(j) <= 119 Then
k = -56
ElseIf d(j) >= 122 And d(j) <= 129 Then
k = -58
ElseIf d(j) >= 133 And d(j) <= 139 Then
k = -61
ElseIf d(j) >= 144 And d(j) <= 149 Then
k = -65
ElseIf d(j) >= 155 And d(j) <= 159 Then
k = -70
ElseIf d(j) >= 166 And d(j) <= 169 Then
k = -76
ElseIf d(j) >= 177 And d(j) <= 179 Then
k = -83
ElseIf d(j) >= 188 And d(j) <= 189 Then
k = -91
ElseIf d(j) = 199 Then
k = -100
ElseIf d(j) >= 222 And d(j) <= 229 Then
k = -122
ElseIf d(j) >= 233 And d(j) <= 239 Then
k = -125
ElseIf d(j) >= 244 And d(j) <= 249 Then
k = -129
ElseIf d(j) >= 255 And d(j) <= 259 Then
k = -134
ElseIf d(j) >= 266 And d(j) <= 269 Then
k = -140
ElseIf d(j) >= 277 And d(j) <= 279 Then
k = -147
ElseIf d(j) >= 288 And d(j) <= 289 Then
k = -155
ElseIf d(j) = 299 Then
k = -164
ElseIf d(j) >= 333 And d(j) <= 339 Then
k = -197
ElseIf d(j) >= 344 And d(j) <= 349 Then
k = -201
ElseIf d(j) >= 355 And d(j) <= 359 Then
k = -206
ElseIf d(j) >= 366 And d(j) <= 369 Then
k = -212
ElseIf d(j) >= 377 And d(j) <= 379 Then
k = -219
ElseIf d(j) >= 388 And d(j) <= 389 Then
k = -227
ElseIf d(j) = 399 Then
k = -236
ElseIf d(j) >= 444 And d(j) <= 449 Then
k = -280
ElseIf d(j) >= 455 And d(j) <= 459 Then
k = -285
ElseIf d(j) >= 466 And d(j) <= 469 Then
k = -291
ElseIf d(j) >= 477 And d(j) <= 479 Then
k = -298
ElseIf d(j) >= 488 And d(j) <= 489 Then
k = -306
ElseIf d(j) = 499 Then
k = -315
ElseIf d(j) >= 555 And d(j) <= 559 Then
k = -370
ElseIf d(j) >= 566 And d(j) <= 569 Then
k = -376
ElseIf d(j) >= 577 And d(j) <= 579 Then
k = -383
ElseIf d(j) >= 588 And d(j) <= 589 Then
k = -391
ElseIf d(j) = 599 Then
k = -400
ElseIf d(j) >= 666 And d(j) <= 669 Then
k = -466
ElseIf d(j) >= 677 And d(j) <= 679 Then
k = -473
ElseIf d(j) >= 688 And d(j) <= 689 Then
k = -481
ElseIf d(j) = 699 Then
k = -490
ElseIf d(j) >= 777 And d(j) <= 779 Then
k = -567
ElseIf d(j) >= 788 And d(j) <= 789 Then
k = -575
ElseIf d(j) = 799 Then
k = -584
ElseIf d(j) >= 888 And d(j) <= 889 Then
k = -672
ElseIf d(j) = 899 Then
k = -681
ElseIf d(j) = 999 Then
k = -780
Else
k = 0
End If
   If j > 1 And d(j - 1) = d(j) Then iti = -1 Else iti = 0 '分割後同じ三桁の場合の位置調整
reiti = d(j) + 16 + k
caunter = Application.CountA(Range(Cells(15, reiti), Cells(190, reiti))) + iti '当選回数
Cells(15 + caunter, reiti) = Sheets("ストレートパターン").Cells(i - 11, 1)  '当選回号
If caunter = 0 Then
  Cells(200 + caunter, reiti) = Sheets("ストレートパターン").Cells(i - 11, 1) '当選間隔
Else
   Cells(200 + caunter, reiti) = Abs(Cells(14 + caunter, reiti) - Cells(15 + caunter, reiti))
 Cells(20, 12) = Cells(14, reiti)
End If
    Cells(400 + caunter, reiti) = Sheets("ストレートパターン").Cells(i - 11, 3) '当選番号
Cells(11, reiti) = Application.Average(Range(Cells(200, reiti), Cells(200 + caunter, reiti)))
Cells(12, reiti) = caunter + 1
Cells(13, reiti) = kaigo - Sheets("ストレートパターン").Cells(i - 11, 1)
Cells(10, reiti) = Application.Max(Range(Cells(200, reiti), Cells(350, reiti)))
Next j
i = i + 1
If i = loopend Then Exit Do
Loop
Cells(12, 236) = Application.Max(Range(Cells(12, 16), Cells(12, 235)))
  Range("P1:IA2").Select
Selection.Copy
Range("ID15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("P12:IA13").Select
Selection.Copy
Range("If15").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
    Call saikeisanon
  End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub tripea_seiretu()   'tripear_sujiの番号,回号、間隔を下並び出力。
Dim degen_max, motosuu As Integer
Dim i, n, start As Integer
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Sheets("box分析").Select
degen_max = Cells(12, 236)
Call saikeisanoff '再計算を止めて計算を速くする
For x = 16 To 235
motosuu = Cells(12, x)
Range(Cells(15, x), Cells(400 + motosuu, x)).Select  '番号,
Selection.Cut
Cells(15 + degen_max - motosuu, x).Select
ActiveSheet.Paste
Next x
Call saikeisanon '再計算を起動させる
End Sub
 ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub ST後追い集計()
Sheets("ストレートパターン").Select
Range("D4:G4500").Select
Selection.Copy
Sheets("多重当選").Select
Cells(15, 104).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("ee15:En24").Select
Selection.ClearContents
Range("dd16") = "=cz15"
   Range("de16") = "=cz16"
Range("df16") = "=da15"
Range("dg16") = "=da16"
Range("dh16") = "=db15"
Range("di16") = "=db16"
Range("dj16") = "=dc15"
Range("dk16") = "=dc16"
Range("DD16:DO16").Select
Selection.Copy
Range("DD16:DO3836").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  
Call saikeisanoff
For ii = 0 To 3000
j = 0
For i = 1 To 4
x = Cells(16 + ii, i + 107 + j)
y = Cells(16 + ii, i + 108 + j)
Cells(y + 15, x + 135) = Cells(y + 15, x + 135) + 1
  j = j + 1
Next i
Cells(25, 122) = ii + 1
Next ii
 Call saikeisanon
 Range("ED14").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub tyusyutu()
Dim kai, i, ii, r, t, span, owari As Integer
Sheets("ストレートパターン").Select
i = 4
 Cells(3, 356) = Empty
'Do Until Cells(i, 3) = ""
kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
If kai = False Or kai = "" Then End
Range("MR4:OF3737").ClearContents
owari = Cells(2, 15) + kai
 Cells(3, 356) = kai
Call saikeisanoff '再計算を止めて計算を速くする
For ii = 0 To owari Step kai
 For r = 0 To 3
Select Case r '千、百,十,一,のデータ表示列位置の設定
Case 0: span = 357 '千百
Case 1: span = 367 '千百
Case 2: span = 377 '千十
Case 3: span = 387 '千一
End Select
  For t = 0 To 9
  Cells(i, t + span) = Application.CountIf(Range(Cells(4 + ii, r + 4), Cells(ii + kai + 3, r + 4)), t)
Next t
Next r
If ii > 0 Then Cells(i - 1, 356) = ii
i = i + 1
Next ii
 Call saikeisanon
End Sub