趣味のエクセルマクロ

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

1.N4ST分析


'ナンバーズ4のストレート分析
Dim hit_m(4000, 4) As String
 Dim hitx(4000, 4) As Integer
 Dim hit(4000, 4) As Integer
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub saikeisanoff()'再計算オフと画面変更オフ
With Application
 .Calculation = xlManual
 .MaxChange = 0.001
 End With
 ActiveWorkbook.PrecisionAsDisplayed = False
 Application.ScreenUpdating = False '画面変更をしない。
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub saikeisanon()'再計算オンと画面変更オン
With Application
 .Calculation = xlAutomatic
 .MaxChange = 0.001
End With
 ActiveWorkbook.PrecisionAsDisplayed = True
 Application.ScreenUpdating = True '画面変更
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー


'40パターン
Sub patapata_40() '当選数字ストレートパターン貼付け
Dim hitx(6000, 4), i, j, k, l, m, n, t As Integer
 Sheets("ストレートパターン").Select
   saikeisanoff
Erase hitx: i = 0: j = 0
i = 4
Do Until Cells(i, 3) = ""
For j = 1 To 4
     Select Case j
         Case 1: span = 1
         Case 2: span = 11
         Case 3: span = 21
         Case 4: span = 31
   End Select
      hitx(i - 3, j) = Cells(i, j + 3) + span
Next j
   i = i + 1
  k = i
 If i = 5000 Then Exit Do
Loop
  m = 0: l = 0
For l = 1 To k - 4
 For m = 1 To 4
       Cells(l + 3, 15 + hitx(l, m)) = "●"  
 Next m
If l >= 2 Then
 For n = 1 To 40
    If Cells(l + 2, 15 + n) <> "●" And Cells(l + 3, 15 + n) = "●" Then 
        t = t + Cells(l + 2, 15 + n)
        Cells(3 + l, 56) = t
        Cells(3 + l, 57) = t / 4 
     End If
  Next n
     t = 0
 End If

Next l
      saikeisanon
Call 入力
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub cunters() '飛び期間を記入する
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Worksheets("ストレートパターン").Select
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 = 4001 Then Exit Do
  i = i + 1
Loop
  If i = 0 Then MsgBox "データ等をチェックして下さい。": End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub plascunt()
Dim p_0 As Integer
  retu = ActiveCell.Column
gyou = ActiveCell.Row
p_0 = Cells(gyou, retu)
Cells(gyou + 1, retu) = p_0 + 1
End Sub
---------------------------------------------------
Sub 横詰め並べ()          
retu = ActiveCell.Column
gyou = ActiveCell.Row           
kijyun = Cells(1, 1)
gejyun = Cells(gyou, 1)
Range(Cells(gyou, 3), Cells(gyou, gejyun + 2)).Select
Selection.Cut

Cells(gyou, kijyun - gejyun + 2).Select
ActiveSheet.Paste
Cells(gyou + 1, 3).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 空行除去() '飛び期間の空行を詰めて表示する。
retu = ActiveCell.Column
gyou = ActiveCell.Row
Dim x, i, k As Integer
Sheets("ストレートパターン").Select
Range("BJ6:CW6").Select
Selection.Copy
Range("BJ7:CW4500").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
 Range("db4:eo800").ClearContents
 saikeisanoff
For x = 1 To 40
   i = 0: k = 0
  Do Until Cells(4 + i, 3) = ""
    If Cells(4 + i, 61 + x) <> "" Then
       Cells(4 + i - k, 105 + x).Value = Cells(4 + i, 61 + x).Value
    Else
       k = k + 1
    End If
        If i = 5000 Then Exit Do
     i = i + 1
  Loop
Next x
If i = 0 Then MsgBox "データ等をチェックして下さい。": End
saikeisanon
Cells(gyou, retu).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 空行除去_2() '飛び期間の空行を詰めて表示する。
Dim x, i, k As Integer
Sheets("ストレートパターン").Select
Range("db4:eo5000").ClearContents
 saikeisanoff
For x = 1 To 40
i = 0: k = 0
Do Until Cells(4 + i, 3) = ""
  If Cells(4 + i, 15 + x) = "●" Then
      If i = 0 Then
          Cells(4 + i - k, 105 + x).Value = 0
  ElseIf i > 0 Then
        If Cells(3 + i, 15 + x) <> "●" Then
           Cells(4 + i - k, 105 + x).Value = Cells(3 + i, 15 + x).Value
         Else
           Cells(4 + i - k, 105 + x).Value = 0
        End If
   End If  
  Else
     k = k + 1
  End If
              If i = 5000 Then Exit Do
    i = i + 1
Loop
Next x
If i = 0 Then MsgBox "データ等をチェックして下さい。": End
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 空白除去()
retu = ActiveCell.Column
gyou = ActiveCell.Row
t_w = 44
i = 0: k = 0
Do Until Cells(gyou + i, 1) = ""
  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 飛び記入() '記入する行をクリックした後マクロ実行する。
gyou = ActiveCell.Row
Call saikeisanoff
If gyou <= 3 Or Cells(gyou, 16) <> "" Then End
For i = 1 To 40
   If Cells(gyou - 1, 15 + i) = "●" Then
     Cells(gyou, 15 + i) = 1
  Else
    Cells(gyou, 15 + i) = Cells(gyou - 1, 15 + i) + 1
 End If
Next i
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー


Sub 飛び記入_4() '記入する行をクリックした後マクロ実行する。
 retu = ActiveCell.Column
 gyou = ActiveCell.Row
For i = 1 To 40
  If Cells(gyou - 1, 15 + i) = "●" Then   '前回●なら今回1、でなければ+1する。
    If Cells(gyou, 15 + i) = "" Then Cells(gyou, 15 + i) = 1
  Else
    If Cells(gyou, 15 + i) = "" Then Cells(gyou, 15 + i) = Cells(gyou - 1, 15 + i) + 1
  End If
Next i
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 休み期間() '行をクリックした後マクロ実行する。
gyou = ActiveCell.Row
 Range(Cells(gyou, 16), Cells(gyou, 55)).Select
Selection.Copy
Sheets("飛び計").Select
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("P12:P41").Select
Application.CutCopyMode = False
Selection.Cut
Range("Q2").Select
ActiveSheet.Paste
Range("Q12:Q31").Select
Selection.Cut
Range("R2").Select
ActiveSheet.Paste
Range("R12:R21").Select
Selection.Cut
Range("S2").Select
ActiveSheet.Paste
Sheets("ストレートパターン").Select
Range("M2").Select
Selection.Copy
Sheets("飛び計").Select
Range("T1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ストレートパターン").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 多重当選カウント()
retu = ActiveCell.Column
gyou = ActiveCell.Row
t_w = 44
 i = 0: k = 0
Do Until Cells(gyou + i, retu) = ""  
 If Cells(gyou + i, retu) = "●" Then
  k = k + 1
  kk = k
Else
 Cells(gyou + i + k - 1, retu + 2) = Empty
 Cells(gyou + i, retu + 2) = kk
 k = 0
End If

 If i = 4001 Then Exit Do
   i = i + 1
Loop
  If i = 0 Then MsgBox "データ等をチェックして下さい。": End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub tajyuu()
Sheets("多重当選").Select
Range("P51:BC56").Select
Selection.Copy
  Range("S4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Sub rencunters()
retu = ActiveCell.Column
gyou = ActiveCell.Row
Call saikeisanoff
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 - 1, retu + 2) = rentyan
  End If
End If
 If i = 4001 Then Exit Do
      i = i + 1
Loop
If i = 0 Then MsgBox "データ等をチェックして下さい。": End
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub ido_inp()
Dim atai As Integer
Sheets("多重当選").Select
retu = ActiveCell.Column
gyou = ActiveCell.Row
If gyou < 55 Or gyou > 70 Then End
atai = Cells(61, retu)
If atai = 0 Then End
  i = 0
Do Until Cells(gyou + i, retu) = ""
   Cells(gyou + i + 1, retu).Select
If i = 4001 Then Exit Do
   i = i + 1
Loop
  start = MsgBox("okしますか?", vbYesNo)
If start = vbYes Then '値記入する
  Cells(gyou + i, retu) = atai * -1
  Cells(gyou, retu).Select
Else
  Cells(61, retu).Select
End If
End Sub
-----------------------------------------------
Sub 多重整列()
start = MsgBox("整列開始しますか?", vbYesNo)
Dim maxdara, i, motosuu As Integer
If start = vbNo Then End
Sheets("多重当選").Select
Range("P64:BC506").Select
Selection.Copy
    Range("BJ64").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
    maxdata = Cells(65, 1)
For i = 62 To 101
   motosuu = Cells(64, i)
   Range(Cells(66, i), Cells(66 + motosuu, i)).Select  '番号
   Selection.Cut
   Cells(66 + maxdata - motosuu, i).Select
   ActiveSheet.Paste
Next i
  Cells(66 + maxdata, 81).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 回go()
ActiveWindow.LargeScroll Down:=3
ActiveWindow.SmallScroll Down:=17
Range("O104").Select
End Sub
Sub kanngo()
 ActiveWindow.ScrollRow = 236
ActiveWindow.SmallScroll Down:=42
Range("O289").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Public patan As Integer
Dim bango As String
--------------------------------------------
Sub testbagen()
For i = 1 To 3000
 Range(Cells(i, 1), Cells(i, 1)).Select
 If Cells(i, 1) = "" Then Exit For
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Cells(i, 1) = "●"
   i = i + 1
Next i
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub three_keta4() 'ストレート順での3桁出現回号表示(全4000データ)
three_keta千百十 'サブプログラム three_keta千百十
three_keta千百一 'サブプログラム three_keta千百一
three_keta千十一
three_keta百十一
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta千百十() 'ストレート順での3桁出現回号表示
Dim i, bangoend As Integer
    Sheets("三桁分析").Select
Range("j28:alu62").Clear
bangoend = Sheets("ストレートパターン").Cells(2, 15)
saikeisanoff
setretu = 0
i = 4
  Do Until Sheets("ストレートパターン").Cells(i, 3) = ""
   setretu = Val(Sheets("ストレートパターン").Cells(i, 4) & Sheets("ストレートパターン"). _
   Cells(i, 5) & Sheets("ストレートパターン").Cells(i, 6)) 
  caunter = Application.Count(Range(Cells(28, 10 + setretu), Cells(45, 10 + setretu)))
    Cells(28 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 1)
    Cells(47 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 3)
    Cells(26, 10 + setretu) = caunter + 1
  If Sheets("ストレートパターン").Cells(i, 1) = bangoend Then
     saikeisanon
     Cells(27, 10 + setretu).Select
  End If
    i = i + 1
  If i = bangoend + 50 Then Exit Do
Loop
  Cells(14, 1) = Cells(24, ActiveCell.Column)
  Cells(15, 1) = Cells(17, ActiveCell.Column)
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta千百一() 'ストレート順での3桁出現回号表示
Dim i, bangoend As Integer
    Sheets("三桁分析").Select
Range("j64:alu99").Clear
   bangoend = Sheets("ストレートパターン").Cells(2, 15)
     saikeisanoff
setretu = 0
   i = 4
 Do Until Sheets("ストレートパターン").Cells(i, 3) = ""
setretu = Val(Sheets("ストレートパターン").Cells(i, 4) & Sheets("ストレートパターン"). _
  Cells(i, 5) & Sheets("ストレートパターン").Cells(i, 7))
    caunter = Application.Count(Range(Cells(64, 10 + setretu), Cells(81, 10 + setretu)))

  Cells(64 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 1)
  Cells(83 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 3)
  Cells(63, 10 + setretu) = caunter + 1
      If Sheets("ストレートパターン").Cells(i, 1) = bangoend Then
         saikeisanon

        Cells(27, 10 + setretu).Select
     End If
    i = i + 1
 If i = bangoend + 50 Then Exit Do
Loop
  Cells(16, 1) = Cells(24, ActiveCell.Column)
  Cells(17, 1) = Cells(18, ActiveCell.Column)
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta千十一() 'ストレート順での3桁出現回号表示
saikeisanoff
Sheets("三桁分析").Select
Range("j101:alu136").Clear
  bangoend = Sheets("ストレートパターン").Cells(2, 15)
 setretu = 0
i = 4
Do Until Sheets("ストレートパターン").Cells(i, 3) = ""
        setretu = Val(Sheets("ストレートパターン").Cells(i, 4) & Sheets("ストレートパターン"). _
  Cells(i, 6) & Sheets("ストレートパターン").Cells(i, 7))
 caunter = Application.Count(Range(Cells(101, 10 + setretu), Cells(119, 10 + setretu)))

 Cells(101 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 1)
 Cells(120 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 3)
 Cells(100, 10 + setretu) = caunter + 1

 If Sheets("ストレートパターン").Cells(i, 1) = bangoend Then
 saikeisanon
 Cells(27, 10 + setretu).Select
End If
 i = i + 1
 If i = bangoend + 50 Then Exit Do
Loop
Cells(18, 1) = Cells(24, ActiveCell.Column)
Cells(19, 1) = Cells(19, ActiveCell.Column)
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta百十一() 'ストレート順での3桁出現回号表示
saikeisanoff
Sheets("三桁分析").Select
Range("j138:alu173").Clear
  bangoend = Sheets("ストレートパターン").Cells(2, 15)
 setretu = 0
i = 4
Do Until Sheets("ストレートパターン").Cells(i, 3) = ""
         setretu = Val(Sheets("ストレートパターン").Cells(i, 5) & Sheets("ストレートパターン"). _
    Cells(i, 6) & Sheets("ストレートパターン").Cells(i, 7))
    Cells(20, 1) = Cells(i, 5)
caunter = Application.Count(Range(Cells(138, 10 + setretu), Cells(156, 10 + setretu)))
 Cells(138 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 1)
 Cells(157 + caunter, 10 + setretu) = Sheets("ストレートパターン").Cells(i, 3)
 Cells(137, 10 + setretu) = caunter + 1
       If Sheets("ストレートパターン").Cells(i, 1) = bangoend Then
     saikeisanon 
     Cells(27, 10 + setretu).Select 
   End If
 i = i + 1
 If i = bangoend + 50 Then Exit Do
Loop
Cells(20, 1) = Cells(24, ActiveCell.Column)
Cells(21, 1) = Cells(20, ActiveCell.Column)
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box_kensaku()
UserForm2.Show 'ユーザーホームを開く
Sheets("三桁分析").Select
On Error GoTo errorcheck
Range("j24:alu24").Select
bango = Application.InputBox("3桁番号入力して下さい")
If bango = "" Then End
Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
retu = ActiveCell.Column: gyou = ActiveCell.Row
Cells(10, 1) = patan
Cells(gyou + patan, retu).Select
    Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub st番号1110表示() 'ストレート番号表示する。
saikeisanoff
Worksheets("ストレートパターン").Range("C4:C4000").Copy
Sheets("三桁分析").Select
Range("ALW28").Select
ActiveSheet.Paste
For j = 1 To 1000
  i = 1
Do Until Cells(27 + i, 9 + j) = ""
If Cells(27 + i, 9 + j) <> "" Then
 bango = Cells(27 + i, 9 + j)
 Cells(27 + i, 9 + j) = Cells(27 + bango, 1011)
End If
   i = i + 1
If i = 15 Then Exit Do
Loop
 Next j
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta千百十一() 'ストレート順での3桁出現回号表示
saikeisanoff
Range("j28:alu42").Clear
bangoend = Application.CountA(Range("ストレートパターン!$C$4:$C$4000"))
 setretu = 0
i = 28
Do Until Cells(i, 1) = bangoend + 1
For j = 2 To 5
setretu = Cells(i, j).Value
Select Case j 'データ表示列位置の設定
    Case 2
        span = 28
    Case 3
        span = 46
    Case 4
        span = 64
    Case 5
        span = 90
End Select

caunter = Application.Count(Range(Cells(28, 10 + setretu), Cells(42, 10 + setretu)))
Cells(28 + caunter, 10 + setretu) = Cells(i, 1)
Cells(26, 10 + setretu) = caunter + 1
Next j
i = i + 1
If Cells(i, 1) = bangoend + 1 Then Cells(27, 10 + setretu).Select
If i = 4000 Then Exit Do
Loop
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub next4number() '次数字を表示する
On Error GoTo errorcheck
Call saikeisanoff '再計算を止めて計算を速くする・
Dim nenum(4) As String, stopnum As Integer
Call saikeisanon
bangoend = Sheets("ストレートパターン").Cells(2, 15)
Range("b12") = "=ストレートパターン!D4&ストレートパターン!D5"
Range("c12") = "=ストレートパターン!E4&ストレートパターン!E5"
Range("d12") = "=ストレートパターン!F4&ストレートパターン!F5"
Range("e12") = "=ストレートパターン!G4&ストレートパターン!G5"
Range("f12") = "=SMALL(ストレートパターン!D4:G4,1)&SMALL(ストレートパターン!D4:G4,2)&SMALL(ストレートパターン!D4:G4,3)&SMALL(ストレートパターン!D4:G4,4)"
Range("b12:f12").Copy Range(Cells(13, 2), Cells(bangoend + 11, 6))
Range(Cells(13, 2), Cells(bangoend + 11, 6)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
kaigo = Application.InputBox("開始回号番号入力して下さい")
If kaigo <= 0 Then End
kaigo = kaigo + 10
Range(Cells(kaigo, 7), Cells(kaigo + 4000, 106)).Select
Selection.ClearContents
  With Selection.Interior
   .Pattern = xlNone
   .TintAndShade = 0
   .PatternTintAndShade = 0
End With
stopnum = Cells(10, 1) + 1
 i = kaigo '12
  Call saikeisanoff
Do Until Cells(i, 1) = Cells(10, 1) + 1
 For n = 1 To 4 '百十一に分ける。
  setretu = Cells(i, 1 + n).Value '番号によりデータ記入位置を設定する。
  Cells(i, setretu + 7) = Cells(i, 1 + n)
  nenum(n) = Cells(i, 1 + n)
 If n = 1 Then
    Cells(i, setretu + 7).Select
   With Selection.Font
 .Color = -16776961
   Selection.Font.Bold = True 
 End With
 ElseIf n = 2 Then
   Cells(i, setretu + 7).Select
With Selection.Font
.Color = -11489280

End With
If nenum(n - 1) = nenum(n) Then
  With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
Selection.Font.Underline = xlUnderlineStyleDouble
  End With
End If
ElseIf n = 3 Then
   Cells(i, setretu + 7).Select
With Selection.Font
  .ThemeColor = xlThemeColorAccent6
   Selection.Font.Underline = xlUnderlineStyleDouble
End With
If nenum(n - 1) = nenum(n) Or nenum(n - 2) = nenum(n) Then
  With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
  Selection.Font.Underline = xlUnderlineStyleDouble
  End With
End If
Else
    Cells(i, setretu + 7).Select
With Selection.Font
  .Color = 2
  Selection.Font.Underline = xlUnderlineStyleSingle
End With
If nenum(n - 3) = nenum(n) Or nenum(n - 2) = nenum(n) Or nenum(n - 1) = nenum(n) Then
  With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
  End With
End If

End If
Next n
i = i + 1
If i = stopnum + 10 Then Exit Do
Loop
 Call saikeisanon '再計算をオンにする
Exit Sub
errorcheck:
MsgBox ("ありません。チェックして下さい"): End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub kankaku_cunters()
retu = ActiveCell.Column
gyou = ActiveCell.Row
j = 0
i = 0
For i = 1 To 777
 If Cells(gyou + i, retu) = "" Then
  j = j + 1
 Else
  Exit For
 End If
Next i
MsgBox "間隔は " & (j)
If i = 999 Then End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー    
Sub 入力()
jp = Cells(2, 15)
Cells(jp + 4, 3).Select
End Sub
Sub 入力赤丸()
Dim maruiti As Object
Sheets("ストレートパターン").Select
retu = ActiveCell.Column
gyou = ActiveCell.Row
Set maruiti = Application.Cells(gyou, retu)
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
End If
Cells(gyou + j, retu).Select
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.Color = -16776961
End Sub