Sub 横飛び記入() '記入する行をクリックした後マクロ実行する。
　retu = ActiveCell.Column
　gyou = ActiveCell.Row
For i = 0 To 20
　　If Cells(gyou, retu + i) <> "" Then End
　If Cells(gyou - 1, retu + i) = "●" Then
　　　Cells(gyou, retu + i) = 1
　Else
　　　Cells(gyou, retu + i) = Cells(gyou - 1, retu + i) + 1
　End If
　If Cells(gyou - 1, retu + i + 1) = "" Then Exit For
Next i
End Sub
-------------------------------------------------------------------------------------------------

Sub allpaint_100() '当選間隔で00-99まで塗りつぶし
　saikeisanoff
For i = 1 To 100
　　h = 1
　Do Until Cells(3 + h, i + 10) = ""
　　If h = 1 Then
　　　hani = Cells(3 + h, i + 10)
　　Else
　　　hani = Cells(3 + h, i + 10) - Cells(3 + h - 1, i + 10)
　　End If
　　If hani <= 50 Then　’当選間隔５０回以下
　　　Cells(3 + h, i + 10).Select
　　　Selection.Font.ColorIndex = 10 '緑4
　　ElseIf hani > 50 And hani <= 100 Then
　　　Cells(3 + h, i + 10).Select
　　　Selection.Font.ColorIndex = 1 '青53=茶黒1
　　ElseIf hani >= 101 And hani <= 300 Then
　　　Cells(3 + h, i + 10).Select
　　　Selection.Font.ColorIndex = 3 '赤
　　ElseIf hani > 300 Then
　　　Cells(3 + h, i + 10).Select
　　　Selection.Font.ColorIndex = 3 '赤
　　　Selection.Font.Bold = True
　　　Selection.Font.Underline = xlUnderlineStyleSingle
　　End If
　　　lashani = Cells(3 + h, i + 10)
　　h = h + 1
　　　Cells(100, i + 10) = lashani
　　If h = 65 Then Exit Do
　Loop
Next i
Cells(4, 11).Select
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub hanntei2_100()
 For i = 1 To 100
　　h = 1
　Do Until Cells(3 + h, i + 111) = ""
　　If h = 1 Then
　　　hani = Cells(3 + h, i + 111)
　　Else
　　　hani = Cells(3 + h, i + 111) - Cells(3 + h - 1, i + 111)
　　End If
　　If hani <= 50 Then
　　　Cells(3 + h, i + 111).Select
　　　Selection.Font.ColorIndex = 50 '緑
　　ElseIf hani > 50 And hani <= 100 Then
　　　Cells(3 + h, i + 111).Select
　　　Selection.Font.ColorIndex = 1 '黒1青5
　　Else
　　　Cells(3 + h, i + 111).Select
　　　Selection.Font.ColorIndex = 3 '赤
　　End If
　　lashani = Cells(3 + h, i + 111)
　　　h = h + 1
　　If h = 30 Then Exit Do
　Loop
Next i
　Cells(2, 111).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub cunters() '飛び期間を記入する
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
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 = 4000 Then Exit Do
  i = i + 1
Loop
  If i = 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 空白除去()
retu = ActiveCell.Column
gyou = ActiveCell.Row
t_w = 44
i = 0: k = 0
Do Until Cells(gyou + i, 2) = ""
If Cells(gyou + i, retu) <> "" Then
       Cells(gyou + i - k, retu + t_w) = Cells(gyou + i, retu)
Else
   k = k + 1
End If
  If i = 5000 Then Exit Do
  i = i + 1
Loop
If i = 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub boxsort()
' マクロ記録日 : 2006/12/22  
Range("BH9:BL724").Select
  Selection.Sort Key1:=Range("BJ9"), Order1:=xlAscending, Key2:=Range("BH9" _
), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
xlSortNormal, DataOption2:=xlSortTextAsNumbers
End Sub
Sub ban_go() '判定番号位置欄に移動する
maebann = Cells(1, 8)
bango = Application.InputBox("番号入力して下さい", Default:=maebann)
start = MsgBox("開始しますか？", vbYesNo)
If start = vbNo Then End
If bango > 99 Or bango < 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
Cells(3, bango + 11).Select
i = 0
Do Until Cells(3 + i, bango + 11) = ""
Cells(4 + i, bango + 11).Select
If i = 64 Then Exit Do
i = i + 1
Loop

res = MsgBox(bango & " の回数記入処理実行？", vbYesNo)
Select Case res
Case vbYes
Call hanntei_100
Case vbNo
Cells(1, 1).Select: End
End Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub hanntei_100()
retu = ActiveCell.Column
gyou = ActiveCell.Row
If Cells(gyou, retu) = "" And Cells(gyou - 1, retu) <> "" Then
Cells(gyou, retu) = Cells(4, 9) + 1 '回数の記入
Cells(9, 10) = gyou
Cells(10, 10) = Cells(3, retu)
Cells(11, 10) = Cells(gyou, retu) - Cells(gyou - 1, retu)
Else
End
End If

h = 1
Do Until Cells(3 + h, retu) = ""
If h = 1 Then
  hani = Cells(3 + h, retu)
Else
  hani = Cells(3 + h, retu) - Cells(3 + h - 1, retu)
End If
If hani <= 50 Then
  Cells(3 + h, retu).Select
  Selection.Font.ColorIndex = 10 '緑4
ElseIf hani > 50 And hani <= 100 Then
  Cells(3 + h, retu).Select
  Selection.Font.ColorIndex = 1 '青53=茶黒1
ElseIf hani >= 101 And hani <= 300 Then
  Cells(3 + h, retu).Select
  Selection.Font.ColorIndex = 3 '赤
ElseIf hani > 300 Then
 Cells(3 + h, retu).Select
 Selection.Font.ColorIndex = 3 '赤
 Selection.Font.Bold = True
 Selection.Font.Underline = xlUnderlineStyleSingle
End If
    lashani = Cells(3 + h, retu)
h = h + 1
Cells(100, retu) = lashani
hh = h
If h = 65 Then Exit Do
Loop

Call kankaku_check
Cells(2 + hh, retu).Select
    Selection.Copy
Range("i4").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(4, 11).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub kankaku_check()
Range("K1:DF1").Select
Selection.Copy
  Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("K2:DF2").Select
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("a5").Select
End Sub
------------------------------------------------------------------------------------------------

変数　知らなかった本当の使い方
Sub 奇偶判定() '奇遇,大小等を判定する。
Dim d(4) As long, tg As long, kg, kgdata, to_ban, ds_pp As String

motodate = Cells(1, 1) '当選番号
　d(1) = Val(Left(motodate, 1)) '当選番号を4つの出目に分ける
　d(2) = Val(Right(Left(motodate, 2), 1))
　d(3) = Val(Left(Right(motodate, 2), 1))
　d(4) = Val(Right(motodate, 1))
　ds_p = 0
For i = 1 To 4
　　If d(i) / 2 = Int(d(i) / 2) Then kg = 2 Else kg = 1 '4つを奇遇に分ける
　If d(i) <= 4 Then '4つを大小に分ける
　　ds = 2
　Else
　　ds = 1
　　ds_p = ds_p + ds
　End If
　tg = tg + d(i) '
　kgdata = kgdata & kg '奇遇データを1と2に分類する
　dsdata = dsdata & ds '大小データを1と2に分類する
Next i
 If kgdata = "1111" Then kgkg = 1
If kgdata = "2222" Then kgkg = 2
If kgdata = "1112" Then kgkg = 3
If kgdata = "1121" Then kgkg = 4
If kgdata = "1211" Then kgkg = 5
If kgdata = "2111" Then kgkg = 6
If kgdata = "2221" Then kgkg = 7
If kgdata = "2212" Then kgkg = 8
If kgdata = "2122" Then kgkg = 9
If kgdata = "1222" Then kgkg = 10
If kgdata = "1122" Then kgkg = 11
If kgdata = "1212" Then kgkg = 12
If kgdata = "1221" Then kgkg = 13
If kgdata = "2211" Then kgkg = 14
If kgdata = "2121" Then kgkg = 15
If kgdata = "2112" Then kgkg = 16
If dsdata = "1111" Then dsds = 1
If dsdata = "2222" Then dsds = 2
If dsdata = "1112" Then dsds = 3
If dsdata = "1121" Then dsds = 4
If dsdata = "1211" Then dsds = 5
If dsdata = "2111" Then dsds = 6
If dsdata = "2221" Then dsds = 7
If dsdata = "2212" Then dsds = 8
If dsdata = "2122" Then dsds = 9
If dsdata = "1222" Then dsds = 10
If dsdata = "1122" Then dsds = 11
If dsdata = "1212" Then dsds = 12
If dsdata = "1221" Then dsds = 13
If dsdata = "2211" Then dsds = 14
If dsdata = "2121" Then dsds = 15
If dsdata = "2112" Then dsds = 16
If ds_p = 0 Then ds_pp = "■■■■": ds_ppn = 4
If ds_p = 1 Then ds_pp = "■■■□": ds_ppn = 3
If ds_p = 2 Then ds_pp = "■■□□": ds_ppn = 2
If ds_p = 3 Then ds_pp = "■□□□": ds_ppn = 1
If ds_p = 4 Then ds_pp = "□□□□": ds_ppn = 0
Cells(1, 2) = kgkg '奇遇パターン
Sheets("合計").Cells(1, 1) = tg '合計数
Sheets("合計").Cells(2, 1) = ds_pp
Sheets("合計").Cells(3, 1) = ds_ppn
Sheets("合計").Cells(2, 41) = motodate & "合計=" & tg '当選番号と合計数
Sheets("合計").Cells(1, 166) = motodate '当選番号
Sheets("千百分析").Cells(1, 2) = motodate '当選番号
Sheets("合計").Cells(2, 166) = dsds '大小パターンを1～16に分ける
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub ●記入() '奇遇パターンに合わせて1～16に表示する。
gyou = ActiveCell.Row
Cells(gyou, 2) = Cells(1, 2)
retu = Cells(gyou, 2)
If retu = "" Then End
If retu >= 17 Then End
Cells(gyou, 3 + retu) = "●"
Cells(gyou + 1, 4).Select
Cells(4, 3 + retu).Select
Selection.Copy
Cells(gyou, 21).Select
ActiveSheet.Paste
Select Case retu
Case 1: n = 0: kgp = "△△△△"
Case 2: n = 4: kgp = "▲▲▲▲"
Case 3: n = 1: kgp = "▲△△△"
Case 4: n = 1: kgp = "▲△△△"
Case 5: n = 1: kgp = "▲△△△"
Case 6: n = 1: kgp = "▲△△△"
Case 7: n = 3: kgp = "▲▲▲△"
Case 8: n = 3: kgp = "▲▲▲△"
Case 9: n = 3: kgp = "▲▲▲△"
Case 10: n = 3: kgp = "▲▲▲△"
Case 11: n = 2: kgp = "▲▲△△"
Case 12: n = 2: kgp = "▲▲△△"
Case 13: n = 2: kgp = "▲▲△△"
Case 14: n = 2: kgp = "▲▲△△"
Case 15: n = 2: kgp = "▲▲△△"
Case 15: n = 2: kgp = "▲▲△△"
Case 16: n = 2: kgp = "▲▲△△"
End Select
　　Cells(gyou, 22) = n
　   Cells(gyou, 23) = kgp
　　Cells(gyou + 1, 4).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub ●計記入() '合計
Sheets("合計").Select
gyou = ActiveCell.Row
Cells(gyou, 2) = Cells(1, 1)
retu = Cells(gyou, 2)
    If retu = "" Then End
If Int(Cells(gyou, 2) / 2) = Cells(gyou, 2) / 2 Then
  Cells(gyou, 2).Select
 With Selection.Font
.Color = -16776961

 End With
Else
 Cells(gyou, 2).Select
 With Selection.Font
.ThemeColor = xlThemeColorLight1
  End With
End If
Cells(gyou, 4 + retu) = "●"
Cells(gyou, 41) = Cells(2, 1)
Cells(gyou, 42) = Cells(3, 1)
  Cells(gyou + 1, 13).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub ●計記入sb() '大小
Sheets("合計").Select
gyou = ActiveCell.Row
Cells(gyou, 167) = Cells(2, 166)
retu = Cells(gyou, 167)
If retu = "" Or retu > 16 Then End
Cells(gyou, 167 + retu) = "●"
Cells(gyou + 1, 168).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub Box_Kensaku()
' kensaku Macro
' マクロ記録日 : 2007/10/9 
Range("B3:W64").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
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box_kensaku_2()
' kensaku Macro
' マクロ記録日 : 2007/10/9 
 Range("aB9:bc800").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
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box_kensaku_3()

 Range("Bh9:bh800").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
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 桁分析()
Call saikeisanoff

Sheets("千百分析").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("千十分析").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("G5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("千一分析 ").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("K5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("百十分析").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("O5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("百一分析 ").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("S5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("十一分析 ").Select
Range("B5:C104").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("桁分析").Select
Range("W5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("z3") = "=COUNT(奇遇!B4:B5000)"
Range("z3") = Range("z3") & "回"
Call saikeisanon
Range("B2").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub coooopio()

  Range("B5:C104").Select
Selection.Copy
Sheets("桁分析").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub seiti_keisan()
Dim tds_p､ds_p As String
Dim ds_pn As Integer
retu = 3
gyou = ActiveCell.Row
If Cells(gyou, retu) <> "" Then End
Range("C3:J3").Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(gyou, retu), Cells(gyou, retu)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("Q3:X3").Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(gyou, retu + 14), Cells(gyou, retu + 14)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(gyou, 12) = Application.Min(Range(Cells(gyou, 3), Cells(gyou, 8)))
Cells(gyou, 13) = Application.Max(Range(Cells(gyou, 3), Cells(gyou, 8)))
For x = 3 To 8
If Cells(gyou, x) <= 100 Then
ds_p = "●": ds_pn = ds_pn + 1
Else
ds_p = "○"
End If
tds_p = tds_p + ds_p
Next x
Cells(gyou, 15) = tds_p
Cells(gyou, 16) = ds_pn
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 入力へ()
w = 2: h = 2
actsheet = ActiveSheet.Name
If actsheet = "合計" Then
retu = 41
ElseIf actsheet = "奇遇" Then
retu = 21
End If
jp = Cells(1, retu) + 3 + h
Cells(jp, w).Select
End Sub
Sub kigu_tyusyutu()
Dim kai, i, ii, r, t, span, owari As Integer
Sheets("奇遇").Select
Range("bm5:cc3737").ClearContents
Cells(4, 65) = Empty
kai = Application.InputBox("集計間隔を入力して下さい", Default:=16)
owari = Cells(1, 21) + kai
Cells(4, 65) = kai
Call saikeisanoff '再計算を止めて計算を速くする・
For t = 0 To 15
i = 5
For ii = 0 To owari Step kai
　 Cells(i, t + 66) = Application.Count(Range(Cells(5 + ii, t + 29), Cells(ii + kai + 4, t + 29)))
　If ii > 0 Then Cells(i - 1, 65) = ii
i = i + 1
Next ii
   Next t
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                     
Sub gokei_tyusyutu()
Dim kai, i, ii, r, t, span, owari As Integer
Sheets("合計").Select
Range("dt4") = Empty
Range("dt5:fe3737").ClearContents                                                      
Call saikeisanoff '再計算を止めて計算を速くする                                                        
kai = Application.InputBox("集計間隔を入力して下さい", Default:=15)
owari = Cells(1, 1) + kai
Cells(4, 124) = kai                                                               
For t = 0 To 36
i = 5
For ii = 0 To owari Step kai                                                     
Cells(i, t + 125) = Application.Count(Range(Cells(5 + ii, t + 45), Cells(ii + kai + 4, t + 45)))       If ii > 0 Then Cells(i - 1, 124) = ii
i = i + 1
Next ii
Next t
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                                                                 
Sub daisyo_tyusyutu()
Dim kai, i, ii, r, t, span, owari As Integer
Sheets("合計").Select
Range("hp4") = Empty
Range("hp5:if3737").ClearContents                                                                                                   Call saikeisanoff '再計算を止めて計算を速くする
    kai = Application.InputBox("集計間隔を入力して下さい", Default:=16)
 owari = Cells(1, 1) + kai
Cells(4, 224) = kai
 For t = 0 To 15
i = 5
For ii = 0 To owari Step kai                                                                                                       
Cells(i, t + 225) = Application.Count(Range(Cells(5 + ii, t + 186), Cells(ii + kai + 4, t + 186)))                                                                                                        
If ii > 0 Then Cells(i - 1, 224) = ii
i = i + 1
Next ii                                                                                                                    
Next t
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                                           
Sub 奇偶間隔式()
Call saikeisanon
Range("ac6") = "=IF(AND(ISNUMBER(D5),ISTEXT(D6)),D5,IF(AND(ISTEXT(D5),ISTEXT(D6)),0,IF(AND(ISTEXT(D5),ISTEXT(D6),ISNUMBER(D7)),1,"")))"
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub daisyou_ptn_kankaku() '●を大小に表示する
Dim k_iti As Integer
Sheets("合計").Select
Call saikeisanoff '再計算を止めて計算を速くする
i = 0
Do Until Cells(5 + i, 167) = ""
k_iti = Cells(5 + i, 167)
If k_iti < 1 And k_iti > 16 Then End
Cells(5 + i, 167 + k_iti) = "●"
i = i + 1
If i = 5000 Then Exit Do
Loop
Call saikeisanon
End Sub

Sub kiguu_ptn_kankaku() '●を奇遇に表示する
Dim k_iti As Integer
Sheets("奇遇").Select
Call saikeisanoff '再計算を止めて計算を速くする
i = 0
Do Until Cells(5 + i, 2) = ""
k_iti = Cells(5 + i, 2)
If k_iti < 1 And k_iti > 16 Then End
Cells(5 + i, 3 + k_iti) = "●"
i = i + 1
If i = 5000 Then Exit Do
Loop
Call saikeisanon
End Sub

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

マクロ　対話型

変数　知らなかった本当の使い方
Sub kiguu_tyusyutu()’各集計間隔での奇数、偶数出現回数集計
Dim kai As long, i As long, ii As long, r As long, t As long, x As long As long
Dim span As long, owari As long
Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Select
i = 4
Cells(3, 454) = Empty
kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
If kai = False Or kai = "" Then End
Range("ql4:qt5000,px4:qa5000").ClearContents
owari = Cells(2, 15) + kai
Cells(3, 454) = kai & "回毎"
Call saikeisanoff '再計算を止めて計算を速くする
i = 4
Do Until Cells(i, 4) = ""
  For x = 0 To 3
If Cells(i, 4 + x) / 2 = Int(Cells(i, 4 + x) / 2) Then
     Cells(i, 440 + x) = 0
Else
     Cells(i, 440 + x) = 1
End If
Next x
 i = i + 1
If i > 5000 Then Exit Do
Loop
i = 4
For ii = 0 To owari Step kai
 For r = 0 To 3
       Select Case r '千、百,十,一,のデータ表示列位置の設定
         Case 0: span = 455 '千
         Case 1: span = 457 '百
         Case 2: span = 459 '十
         Case 3: span = 461 '一
        End Select 
  Cells(i, span) = Application.CountIf(Range(Cells(4 + ii, r + 440), Cells(ii + kai + 3, r + 440)), 1)
Cells(i, span + 1) = Application.CountIf(Range(Cells(4 + ii, r + 440), Cells(ii + kai + 3, r + 440)), 0)
Next r
    If ii > 0 Then Cells(i - 1, 454) = ii
    i = i + 1
Next ii
 Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub 大小_tyusyutu()
Dim kai As long, i As long, ii As long, r As long, t As long, x As long, span, owari As long

Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Select
i = 4
Cells(3, 474) = Empty
kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
If kai = False Or kai = "" Then End
Range("rf4:rn5000,qc4:qf5000").ClearContents
owari = Cells(2, 15) + kai
Cells(3, 474) = kai & "回毎"
Call saikeisanoff '再計算を止めて計算を速くする
Do Until Cells(i, 4) = ""
For x = 0 To 3
  If Cells(i, 4 + x) < 5 Then
     Cells(i, 445 + x) = 0
  Else
     Cells(i, 445 + x) = 1
  End If
Next x
   i = i + 1
  If i > 5000 Then Exit Do
Loop
i = 4
For ii = 0 To owari Step kai
 For r = 0 To 3
       Select Case r '千、百,十,一,のデータ表示列位置の設定
        Case 0: span = 475 '千
        Case 1: span = 477 '百
        Case 2: span = 479 '十
        Case 3: span = 481 '一
       End Select 
  Cells(i, span) = Application.CountIf(Range(Cells(4 + ii, r + 445), Cells(ii + kai + 3, r + 445)), 1)
Cells(i, span + 1) = Application.CountIf(Range(Cells(4 + ii, r + 445), Cells(ii + kai + 3, r + 445)), 0)
Next r
 If ii > 0 Then Cells(i - 1, 474) = ii
    i = i + 1
Next ii
 Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub de_sort()
    Range("ID15:IH234").Select
ActiveWorkbook.Worksheets("box分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("box分析").Sort.SortFields.Add Key:=Range( _
     "IE15:IE234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
     xlSortNormal
ActiveWorkbook.Worksheets("box分析").Sort.SortFields.Add Key:=Range( _
     "IG15:IG234"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
     xlSortNormal
With ActiveWorkbook.Worksheets("box分析").Sort
     .SetRange Range("ID15:IH234")
     .Header = xlGuess
     .MatchCase = False
     .Orientation = xlTopToBottom
     .SortMethod = xlPinYin
     .Apply
End With

  If Cells(14, 246) = 0 Then
      Range("ID15:IH41").Select
      Selection.Copy
      Range("IM15").Select
      ActiveSheet.Paste
   End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub pea_next_box()
Dim j As long, i As long, k As long, retu As long, iti As long, clored As long
j = 0: i = 4: k = 0: retu = 0
   start = MsgBox("開始しますか？", vbYesNo)
If start = vbNo Then End
Sheets("次数字").Select
Range("gh10:ij10") = Empty
Range("gh12:ik4000").Clear
bangoend = Cells(10, 1)
Range("ga12") = "=LEFT(F12,2)"
Range("gb12") = "=LEFT(F12,1)&MID(F12,3,1)"
Range("gc12") = "=LEFT(F12,1)&RIGHT(F12,1)"
Range("gd12") = "=MID(F12,2,2)"
Range("ge12") = "=MID(F12,2,1)&RIGHT(F12,1)"
Range("gf12") = "=RIGHT(F12,2)"
Range("gg12") = "=F12"
Range("ga12:gg12").Copy Range(Cells(13, 183), Cells(11 + bangoend, 189))
Call saikeisanoff
 i = 12
Do Until Cells(i, 189) = ""
k = 0
For j = 0 To 5 '出目の入力348

d = Cells(i, j + 183).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 + 190 + k
   caunter = Application.CountA(Range(Cells(12, retu), Cells(500, retu)))
   Cells(10, retu) = caunter

  iti = 0 '分割後同じ2桁の場合の位置調整
If j = 1 Then
     If Cells(i, j + 182) = Cells(i, j + 183) Then iti = -1
 ElseIf j = 2 Then
     If Cells(i, j + 182) = Cells(i, j + 183) Then iti = -1
 ElseIf j = 3 Then
     If Cells(i, j + 181) = Cells(i, j + 183) Then iti = -1
     If Cells(i, j + 182) = Cells(i, j + 183) Then iti = -1
ElseIf j = 4 Then
     If Cells(i, j + 181) = Cells(i, j + 183) Then iti = -1
     If Cells(i, j + 182) = Cells(i, j + 183) Then iti = -1
ElseIf j = 5 Then
     If Cells(i, j + 182) = Cells(i, j + 183) Then iti = -1
End If   
        Cells(600 + iti + caunter, retu) = Cells(i + 1, 1) '当選回   
        Cells(12 + iti + caunter, retu) = Cells(i + 1, 189) '当選番号
      If caunter = 0 Then
          Cells(1100 + iti + caunter, retu) = Cells(i + 1, 1) '当選間隔
      Else
          Cells(1100 + iti + caunter, retu) = Abs(Cells(600 + iti + caunter, retu) - Cells(599 + iti + caunter, retu))   '当選間隔
          clored = Cells(1100 + iti + caunter, retu)          
         Select Case clored
         Case 0 To 5
           Cells(12 + iti + caunter, retu).Select
           Selection.Font.ColorIndex = 10 '緑4       
           Case 6 To 10
           Cells(12 + iti + caunter, retu).Select
             Selection.Font.ColorIndex = 7
          Case 11 To 29
          Cells(12 + iti + caunter, retu).Select
              Selection.Font.ColorIndex = 1 '黒1
         Case Else
            Cells(12 + iti + caunter, retu).Select
             Selection.Font.ColorIndex = 3 '赤
        End Select    
      End If
Next j
i = i + 1
    If i = 4001 Then Exit Do
Loop
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
 Sub pea_next_box_seiretu()   'tripear_sujiの番号,回号、間隔を下並び出力。
Dim degen_max As long, motosuu As long
Dim i As long, n As long, start As long, x As long
   start = MsgBox("開始しますか？", vbYesNo)
If start = vbNo Then End
Sheets("次数字").Select
start = MsgBox("整列開始しますか？", vbYesNo)
If start = vbNo Then End
 degen_max = Cells(9, 190)
   Call saikeisanoff '再計算を止めて計算を速くする
For x = 190 To 244
    motosuu = 0
  motosuu = Cells(10, x)
If degen_max > motosuu Then
   Range(Cells(12, x), Cells(motosuu + 1700, x)).Select  '番号,
   Selection.Cut
   Cells(12 + degen_max - motosuu, x).Select
   ActiveSheet.Paste
End If
Next x
Call saikeisanon '再計算を起動させる
End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
 Sub deme_st4間隔() 'deme間隔でアンダーバー引く
Dim i As long, k As long, gyou As long, retu As long
Dim deme As long, ndeme As long, yiti As long
Dim demebar As Object, ndemebar As Object
Dim  tdemebarAs Object, demerenbar As Object

Worksheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
deme = Cells(gyou, retu)
Set demebar = Application.Cells(gyou, retu)
Set ndemebar = Application.Cells(gyou, retu + 4)
  i = 1
 Do Until deme = Cells(gyou - i, retu)
i = i + 1
k = i - 1
If i = 2000 Then Exit Do
Loop
If k >= 11 And k <= 29 Then
  demebar.Font.Underline = xlUnderlineStyleSingle
  ndemebar.Font.Underline = xlUnderlineStyleSingle

ElseIf k >= 30 Then
  demebar.Font.Underline = xlUnderlineStyleDouble
  ndemebar.Font.Underline = xlUnderlineStyleDouble

Else
  demebar.Font.Underline = xlUnderlineStyleNone
  ndemebar.Font.Underline = xlUnderlineStyleNone
End If
If k = 0 Then
   Cells(gyou, retu + 4) = 0
Else
   Cells(gyou, retu + 4) = k
End If
   Cells(gyou + 1, retu).Select
deme_st4間隔
'return0

End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
  Sub HotNo_KanakuWriter() 'ホットナンバーの間隔記入予備作業
Dim kankaku_d As long, iti As long
Dim gyou As long, retu As long

  gyou = ActiveCell.Row
retu = ActiveCell.Column
kankaku_d = Cells(gyou, retu)
If kankaku_d <= 3 Then 'ホット間隔数記入
Cells(17, retu + 133).Select
h = 0
Do Until Cells(17 + h, retu + 133) = ""
     h = h + 1
   Cells(16 + h, retu + 133).Select
     If h = 50 Then Exit Do
Loop
  End
End If
Cells(100, retu + 133).Select 'ホット間隔開始記入準備
i = 0
Do Until Cells(100 + i, retu + 133) = ""
     i = i + 1
     If i = 500 Then Exit Do
Loop
Cells(100 + i, retu + 133).Select
start = MsgBox(kankaku_d & "  間隔はok？", vbYesNo)
   If start = vbYes Then
     Cells(100 + i, retu + 133) = kankaku_d
   Else
     End 
   End If
iti = Cells(15, retu + 133) + 17  
Cells(iti, retu + 133).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub copy_100()
    Range("ID15:IH41").Select
  Selection.Copy
   Range("IM15").Select
  ActiveSheet.Paste
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub deme_uesita()  ’入力した出目の前後の出目をすべての桁でチェックする
Dim deme As long, j As long, i As long, kaigou As long
Dim gyou_deme As long, retu_deme As long
 Worksheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Select
kaigou = Cells(2, 15) + 3
Range("TA4:TD5000").Select

Selection.ClearContents
Range(Cells(4, 4), Cells(kaigou, 7)).Select
  Selection.Copy
  Range("SV4").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  deme = Cells(2, 523)
i = 1
  Do Until Cells(3 + i, 519) = ""
    For j = 1 To 4
     If Cells(4 + i, 515 + j) = deme Then  
          Cells(3 + i, 520 + j) = Cells(3 + i, 515 + j)
          Cells(4 + i, 520 + j) = deme
          Cells(5 + i, 520 + j) = Cells(5 + i, 515 + j)        
     End If     
   Next j
        i = i + 1
        If i > 5000 Then Exit Do
  Loop
    Cells(kaigou - 50, 520).Select
 End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub ban_gox() '判定番号位置欄に移動する
Dim bango As String
bango = Application.InputBox("小さい順に番号入力して下さい")
start = MsgBox("開始しますか？", vbYesNo)
If start = vbNo Then Range("P14:IA14").Select: End
'If bango > 99 Or bango < 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
 Range("P14:IA14").Select
  Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
      :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
      True, SearchFormat:=False).Activate
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub go_last() '3桁番号のラストに移動する。
Dim idocell As long
Sheets("box分析").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
  idocell = Application.CountA(Range(Cells(15, 256), Cells(700, 256))) + 15
Range(Cells(gyou, 247), Cells(gyou, 252)).Select
  Selection.Cut
Cells(idocell, 256).Select
   ActiveSheet.Paste
End Sub

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

 Sub next_total() '次合計を表示する
Dim kai As long
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 As long, kigu_max As long, daisyo_max As long
Dim  mini_pmax As long, mini_smax As long
Dim i As long, ii As long, j As long, jj As long, k As long, start As long
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 As long, jisyyji As long, h As long, j As long, i As long
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 As long, i As long, k As long, retu As long
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 setretu As long, span As long, writretu As long, kaigo As long
Dim j As long, k As long, i As long, n As long, caunter As long, maxx As long

 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 As long, motosuu As long
Dim i As long, n As long, start As long
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) As long, i As long, j As long, k As long, iti As long
Dim caunter As long, reiti As long, loopend As long
   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 As long, motosuu As long
Dim i As long, n As long, start As long
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 As long, i As long, ii As long, r As long, t As long, span As long, owari As long
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