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