趣味のエクセルマクロ&数字選択式宝くじ

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

3.No.3 分析

Sub kiguu3間隔() '奇数偶数の間隔でアンダーバー引く
Dim i, k, gyou, kiguu As Integer
Dim kiguubar, nkiguubar As Range 'オブジェクト変数を設定する。
Worksheets("原本").Select
  gyou = ActiveCell.Row
  If ActiveCell.Column <> 92 Then End
    kiguu = Cells(gyou, 92)
  Set kiguubar = Application.Cells(gyou, 92)'オブジェクト変数にセル範囲を設定する。
  Set nkiguubar = Application.Cells(gyou, 12)
   i = 1
Do Until kiguu = Cells(gyou - i, 92)
   i = i + 1
   k = i - 1
  If i = 4000 Then Exit Do
Loop
If k < 9 Then  ’間隔8以下は何も線無し
 kiguubar.Font.Underline = xlUnderlineStyleNone'オブジェクト変数のセルのプロパティを設定。
 nkiguubar.Font.Underline = xlUnderlineStyleNone
ElseIf k >= 9 And k < 19 Then ’間隔9以上18以下に下線
 kiguubar.Font.Underline = xlUnderlineStyleSingle
 nkiguubar.Font.Underline = xlUnderlineStyleSingle
Else’間隔19以上に二重線
 kiguubar.Font.Underline = xlUnderlineStyleDouble
 nkiguubar.Font.Underline = xlUnderlineStyleDouble
End If
 'kiguu3間隔  '同じ処理を繰り返す時(再帰処理をする)
End Sub
------------------------------  

 Sub deme3間隔() 'deme間隔でアンダーバー引く
 Dim i, k, gyou, retu, deme As Integer
 Dim demebar, demebar2 As Range
Worksheets("原本").Select
On Error GoTo errorcheck
gyou = ActiveCell.Row
retu = ActiveCell.Column
If ActiveCell.Column <= 4 And ActiveCell.Column >= 8 Then End
deme = Cells(gyou, retu)
Set demebar = Application.Cells(gyou, retu)
Set demebar2 = Application.Cells(gyou, retu + 169)
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 Then
demebar.Font.Underline = xlUnderlineStyleNone
demebar2.Font.Underline = xlUnderlineStyleNone
ElseIf k >= 11 And k <= 29 Then
demebar.Font.Underline = xlUnderlineStyleSingle
demebar2.Font.Underline = xlUnderlineStyleSingle
Else
demebar.Font.Underline = xlUnderlineStyleDouble
demebar2.Font.Underline = xlUnderlineStyleDouble
End If


Cells(gyou + 1, retu).Select   
If k = 0 Then
Cells(gyou, retu + 169) = 0
Else
Cells(gyou, retu + 169) = k
End If       


'deme3間隔
'自動で脇の桁に移動
If Cells(gyou + 1, retu) = "" Then
  Cells(gyou, retu + 1).Select
End
End If      
Exit Sub
errorcheck:
MsgBox "エラー番号" & Err & ":" & Error(Err): End  
End Sub
------------------------------ 
Sub total3間隔() '出目合計間隔でアンダーバー選択(各合計の確率により)
Dim i, k, gyou, total As Integer
Dim totalbar As Range
Worksheets("原本").Select
  gyou = ActiveCell.Row
If ActiveCell.Column <> 90 Then End
 total = Cells(gyou, 90)
 Set totalbar = Application.Cells(gyou, 90)
 i = 1
Do Until total = Cells(gyou - i, 90)
 i = i + 1
 k = i - 1
If i = 3000 Then Exit Do
Loop
 If total = 7 Then’合計7の時
    If k >= 29 And k < 58 Then frg = 1’フラグ1とする
   If k >= 58 Then frg = 2
End If
If total = 8 Then
 If k >= 24 And k < 48 Then frg = 1
 If k >= 48 Then frg = 2
End If
If total = 9 Then
 If k >= 20 And k < 40 Then frg = 1
 If k >= 40 Then frg = 2
End If
If total = 10 Then
 If k >= 17 And k < 34 Then frg = 1
 If k >= 34 Then frg = 2
End If
If total = 11 Then
 If k >= 13 And k < 32 Then frg = 1
 If k >= 32 Then frg = 2
End If
If total = 12 Then
 If k >= 15 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 13 Then
 If k >= 15 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 14 Then
 If k >= 15 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 15 Then
 If k >= 15 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 16 Then
 If k >= 16 And k < 32 Then frg = 1
 If k >= 32 Then frg = 2
End If
If total = 17 Then
 If k >= 17 And k < 34 Then frg = 1
 If k >= 34 Then frg = 2
End If
If total = 18 Then
 If k >= 20 And k < 40 Then frg = 1
 If k >= 40 Then frg = 2
End If
If total = 19 Then
 If k >= 24 And k < 48 Then frg = 1
 If k >= 48 Then frg = 2
End If
If total = 20 Then
 If k >= 29 And k < 58 Then frg = 1
 If k >= 58 Then frg = 2
End If
If frg = 1 Then
 totalbar.Font.Underline = xlUnderlineStyleSingle
 ElseIf frg = 2 Then
 totalbar.Font.Underline = xlUnderlineStyleDouble
Else
 totalbar.Font.Underline = xlUnderlineStyleNone
End If
 'total3間隔
End Sub
------------------------------ 
Sub total3mini間隔() 'ミニの間隔でアンダーバー引く
Dim i, k, gyou, total, frg As Integer
Dim totalbar As Range
Worksheets("原本").Select
  gyou = ActiveCell.Row
  If ActiveCell.Column <> 105 Then End
  total = Cells(gyou, 105)
   Set totalbar = Application.Cells(gyou, 105)
 i = 1
Do Until total = Cells(gyou - i, 105)
 i = i + 1
 k = i - 1
 If i = 3000 Then Exit Do
Loop
 frg = 0
If total = 0 Or total = 18 Then
 If k >= 50 And k < 100 Then frg = 1
 If k >= 100 Then frg = 2
End If
If total = 1 Or total = 17 Then
 If k >= 100 And k < 200 Then frg = 1
 If k >= 200 Then frg = 2
End If
If total = 2 Or total = 16 Then
 If k >= 34 And k < 68 Then frg = 1
 If k >= 68 Then frg = 2
End If
If total = 3 Or total = 15 Then
 If k >= 26 And k < 50 Then frg = 1
 If k >= 50 Then frg = 2
End If
If total = 4 Or total = 14 Then
 If k >= 21 And k < 40 Then frg = 1
 If k >= 40 Then frg = 2
End If
If total = 5 Or total = 13 Then
 If k >= 18 And k < 34 Then frg = 1
 If k >= 34 Then frg = 2
End If
If total = 6 Or total = 12 Then
 If k >= 16 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 7 Or total = 11 Then
 If k >= 14 And k < 26 Then frg = 1
 If k >= 26 Then frg = 2
End If
If total = 8 Or total = 10 Then
 If k >= 13 And k < 24 Then frg = 1
 If k >= 24 Then frg = 2
End If
If total = 9 Then
 If k >= 11 And k < 20 Then frg = 1
 If k >= 20 Then frg = 2
End If
 If frg = 1 Then
 totalbar.Font.Underline = xlUnderlineStyleSingle
ElseIf frg = 2 Then
 totalbar.Font.Underline = xlUnderlineStyleDouble
Else
 totalbar.Font.Underline = xlUnderlineStyleNone
End If
'  total3mini間隔
  End Sub
------------------------------   
Sub Spase3mini間隔() 'ミニスペース間隔でアンダーバー引く
Dim i, k, gyou, space, frg As Integer
Dim spacebar As Range
  Worksheets("原本").Select
  gyou = ActiveCell.Row
  If ActiveCell.Column <> 106 Then End
  space = Cells(gyou, 106)
   Set spacebar = Application.Cells(gyou, 106)
   i = 1
Do Until space = Cells(gyou - i, 106)
 i = i + 1
 k = i - 1
 If i = 5000 Then Exit Do
Loop
 frg = 0
If space = 0 Or space = 5 Then
 If k >= 11 And k <= 21 Then frg = 1
 If k >= 22 Then frg = 2
End If
If space = 1 Then
 If k >= 6 And k <= 11 Then frg = 1
 If k >= 12 Then frg = 2
End If
If space = 2 Then
 If k >= 7 And k <= 13 Then frg = 1
 If k >= 14 Then frg = 2
End If
If space = 3 Then
 If k >= 8 And k <= 15 Then frg = 1
 If k >= 16 Then frg = 2
End If
If space = 4 Then
 If k >= 9 And k <= 17 Then frg = 1
 If k >= 18 Then frg = 2
End If
If space = 6 Then
 If k >= 13 And k <= 25 Then frg = 1
 If k >= 26 Then frg = 2
End If
If space = 7 Then
 If k >= 17 And k <= 33 Then frg = 1
 If k >= 34 Then frg = 2
End If
If space = 8 Then
 If k >= 26 And k <= 51 Then frg = 1
 If k >= 52 Then frg = 2
End If
If space = 9 Then
 If k >= 51 And k <= 101 Then frg = 1
 If k >= 102 Then frg = 2
End If
If frg = 1 Then
 spacebar.Font.Underline = xlUnderlineStyleSingle
ElseIf frg = 2 Then
 spacebar.Font.Underline = xlUnderlineStyleDouble
Else
 spacebar.Font.Underline = xlUnderlineStyleNone
End If
' Spase3mini間隔
End Sub
------------------------------ 
Sub stpear_suji()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を出力。
Dim j, k, i, n, caunter, Maxx, setretu, span, writretu As Integer
   Sheets("原本").Select
   Call saikeisanoff '再計算を止めて計算を速くする
   caunter = 0
   Range("BXL4:EAE3904").Select '出力表示部のクリア
   Selection.ClearContents
i = 4
Do Until Cells(i, 1899) = "" And Cells(i, 1900) = ""
 For n = 1 To 6 '百十、百一、十一に分ける。
    setretu = Cells(i, 1892 + n).Value '番号によりデータ記入位置を設定する。
       Select Case n '千百、千十、千一,百十,百一,十一のデータ表示列位置の設定
   Case 1: span = 1988 '千百
   Case 2: span = 2113 '千十
   Case 3: span = 2238 '千一
   Case 4: span = 2363 '百十
   Case 5: span = 2488 '百一
   Case 6: span = 2613 '十一
    End Select
    writretu = setretu + span
 caunter = Application.CountA(Range(Cells(4, writretu), Cells(70, writretu)))    '記入位置をカウンタから計算する。
   Cells(4 + caunter, writretu) = Cells(i, 15)    '番号データを4行から記入する。
   Cells(100 + caunter, writretu) = Cells(i, 1899)   '回号データを記入する。
If caunter = 0 Then '回号データの間隔を300行から記入する
 Cells(200 + caunter, writretu) = Cells(i, 1899)
Else
 Cells(200 + caunter, writretu) = Abs(Cells(99 + caunter, writretu) - Cells(100 + caunter, writretu))
End If
   Cells(2, writretu) = caunter + 1   '合計カウンタを計算表示する
Next n
 i = i + 1
 If i = 4001 Then Exit Do
Loop
Call saikeisanon '再計算を起動させる
End Sub
------------------------------ 
Sub TKGM_syuukei()   '回号、番号間隔、を出力。
Dim j, k, i, n, nn, caunter, Maxx, setretu, span, writretu, kaigo, start, gyou As Integer
start = MsgBox("集計を開始しますか?", vbYesNo)
If start = vbNo Then End
   Sheets("原本").Select
    caunter = 0
   Range("gr7:lg5000").ClearContents '出力表示部のクリア
Call saikeisanon
    kaigo = Range("l1")
  Range("gi10") = "=CL3 " 'データを参照する
  Range("gj10") = "=CN3 "
  Range("gk10") = "=DG3 "
  Range("gl10") = "=DA3 "
  Range("gm10") = "=DB3 "
  Range("gi10:gm10").Copy Range(Cells(11, 191), Cells(9 + kaigo, 195)) 'データを回号分コピー
    Range(Cells(11, 191), Cells(9 + kaigo, 195)).Select
    Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
   i = 10
Call saikeisanoff '再計算を止めて計算を速くする
Do Until Cells(i - 7, 4) = ""
  For n = 1 To 5
 Select Case n 'データ表示列位置の設定
  Case 1:  span = 200 '合計
  Case 2:  span = 240 '奇数偶数
  Case 3:  span = 260 '大小
  Case 4:  span = 280 'ミニスプラス
  Case 5:  span = 310 'ミニスぺース
 End Select
 setretu = Cells(i, 190 + n).Value '番号によりデータ記入位置を設定する。
 writretu = setretu + span
caunter = Application.CountA(Range(Cells(10, writretu), Cells(1000, writretu))) '記入位置をカウンタから計算する。
  Cells(10 + caunter, writretu) = Cells(i - 7, 4)  '番号データを5行から記入する。
  Cells(1200 + caunter, writretu) = Cells(i - 7, 1) '回号データを記入する。
If caunter = 0 Then '回号データの間隔を2300行から記入する
 Cells(2300 + caunter, writretu) = Cells(i - 7, 1)
Else
 Cells(2300 + caunter, writretu) = Abs(Cells(1200 + caunter, writretu) - Cells(1199 +   caunter, writretu))
End If
 Cells(7, writretu) = caunter + 1   '合計カウンタを計算表示する
'最終当選間隔計算
 Cells(4, writretu) = Application.Max(Range(Cells(1200, writretu), Cells(2100, writretu)))
Next n
 i = i + 1
   If i = 5000 Then Exit Do
Loop
 Cells(kaigo + 9, 190).Select
 gyou = ActiveCell.Row
 Cells(kaigo + 9, 190) = gyou - 9
Call saikeisanon '再計算を起動させる
 Cells(kaigo + 9, 190).Select
End Sub

------------------------------ 

Sub kankaku_sita_syuukei()   ' 間隔を下並びで出力。整列コピーする準備
 
 Dim j, k, x, n, nn, caunter, Maxx, setretu, span, writretu, kaigo, startgyou, start, gyou As Integer
start = MsgBox("間隔下並び集計を開始しますか?", vbYesNo)


If start = vbNo Then End


 Sheets("原本").Select
  
caunter = 0
  
    Range("gr4500:lh7501").ClearContents '出力表示部のクリア
    Call saikeisanon
 
    kaigo = Range("l1")
      
    Range("gi10") = "=CL3 " 'データを参照する
    Range("gj10") = "=CN3 "
    Range("gk10") = "=DG3 "
    Range("gl10") = "=DA3 "
    Range("gm10") = "=DB3 "
    Range("gi10:gm10").Copy Range(Cells(11, 191), Cells(9 + kaigo, 195)) 'データを回号分コピー
   
     Range(Cells(11, 191), Cells(9 + kaigo, 195)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
     startgyou = 9 + kaigo
   Call saikeisanoff '再計算を止めて計算を速くする


For x = startgyou To 10 Step -1


  For n = 1 To 5
         
        Select Case n 'データ表示列位置の設定
           Case 1:  span = 200 '合計
           Case 2:  span = 240 '奇数偶数
           Case 3:  span = 260 '大小
           Case 4:  span = 280 'ミニスプラス
           Case 5:  span = 310 'ミニスぺース
         End Select
        setretu = Cells(x, 190 + n).Value '番号によりデータ記入位置を設定する。
          
        writretu = setretu + span
         caunter = Application.CountA(Range(Cells(4500, writretu), Cells(5500, writretu)))  
   
   '記入位置をカウンタから計算する。
    
        Cells(5501, writretu) = caunter
   
     If caunter = 0 Then '回号データを5500行から記入し間隔を表示する
        Cells(5500, writretu) = Cells(x, 190)
        Cells(5502, writretu) = kaigo - Cells(5500, writretu)
     Else
        Cells(5500 - caunter, writretu) = Cells(x, 190)
        If caunter = 1 Then
          Cells(5500, writretu) = Cells(5500, writretu) - Cells(5500 - caunter, writretu)
        ElseIf caunter >= 2 Then
          Cells(5501 - caunter, writretu) = Cells(5501 - caunter, writretu) - Cells(5500 - caunter, writretu)
        End If
       
     End If
       
     Cells(5501, writretu) = caunter + 1   '合計カウンタを計算表示する
     Cells(5504, writretu) = kaigo - Cells(5502, writretu)
    Next n
Next x


Cells(5501, 320) = 5501 - Application.Max(Range(Cells(5501, 200), Cells(5501, 319)))
Cells(5501, 199) = "=SUM(GR5501:HS5501)"
Call saikeisanon '再計算を起動させる
Cells(kaigo + 9, 190).Select
End Sub
------------------------------------------------------------------------------------------------------------------------
Sub 整列Copi_propaty() 'Sub kankaku_sita_syuukei()で間隔を下並びで出力後シート「プロパテイ」に整列コピー
  Dim Maxx, start As Integer
  start = MsgBox("「各間隔データ集計」を「プロパテイ」にコピーしますか?", vbYesNo)
   
 Call saikeisanoff '再計算を止めて計算を速くする・
If start = vbNo Then End
   Sheets("プロパテイ").Select


    Sheets("原本").Select '合計
 
          Maxx = Cells(5501, 320)
  
     Range(Cells(Maxx, 209), Cells(5500, 223)).Select


     Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("C16").Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   '-----------------------------------------------------------
        Sheets("原本").Select '奇数偶数
     Range(Cells(Maxx, 241), Cells(5500, 248)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("C43").Select
  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    '----------------------------------------------------------
    Sheets("原本").Select '大小
          Range(Cells(Maxx, 261), Cells(5500, 268)).Select
         Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
 
    Range("C53").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
       
    '----------------------------------------------------------
        Sheets("原本").Select 'ミニプラス
      Range(Cells(Maxx, 280), Cells(5500, 298)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
  
    Range("C64").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   '-----------------------------------------------------------
    Sheets("原本").Select 'ミニスペース
       Range(Cells(Maxx, 310), Cells(5500, 319)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("c87").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
     Cells(1, 1) = Sheets("原本").Cells(1, 197)
    
     '******************************
     
     '前回当選からの間隔
    
      Sheets("原本").Select
    Range("GV5502:HO5502").Select
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("BCE16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
       
    Sheets("原本").Select
  
    Range("IG5502:IN5502").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
 
    Range("BCE43").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
 
    Sheets("原本").Select
    Range("JA5502:JH5502").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("BCE53").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
  
    Sheets("原本").Select
  
    Range("JT5502:KL5502").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("BCE64").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
  
    Sheets("原本").Select
   
    Range("KX5502:LG5502").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("プロパテイ").Select
    Range("BCE87").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
   Call saikeisanon '再計算
      Range("a3").Select
End Sub

------------------------------ 
 Sub next_3total() '次合計を表示する
Sheets("次数字").Select
Range("io12:jp6000").ClearContents '出力表示部のクリア
Call saikeisanoff '再計算を止めて計算を速くする・
   Sheets("原本").Select
   las10 = Cells(1, 12)
   Range("CL3:CL5000").Select
   Range(Cells(3, 90), Cells(3 + las10, 90)).Select
   Selection.Copy
   Sheets("次数字").Select
   Range("IM15").Select
   ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = 15
Do Until Cells(i, 247) = ""
 retu_1 = Cells(i, 247).Value + 249
 nextotal = Cells(i + 1, 247)
  caunter = Application.Count(Range(Cells(15, retu_1), Cells(500, retu_1))) + 1
 Cells(13, retu_1) = caunter
 Cells(caunter + 15, retu_1) = nextotal
 i = i + 1
 If i = 4001 Then Exit Do
Loop
  Call saikeisanon '再計算をオンにする・
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub nextsuuji_3keta() '桁別次数字を表示する
Dim retu_1, jisyyji, h, j, i As Integer
  start = MsgBox("開始しますか?", vbYesNo)
  If start = vbNo Then End
  Sheets("次数字").Select
    Range("dv12:ey6000").Clear '出力表示部のクリア
    Application.ScreenUpdating = False '画面変更オフ
 Sheets("原本").Select
    Range("E3:G5000").Select
    Selection.Copy
 Sheets("次数字").Select
Range("DR12").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, 123) = ""
 For j = 1 To 3
  Select Case j 'データ表示列位置の設定
   Case 1:  span = 126: h = 0 '百桁
   Case 2:  span = 136: h = 1 '十桁
   Case 3:  span = 146: h = 2 '一桁
  End Select
  retu_1 = 0
  retu_1 = Cells(i, 122 + h).Value + span
  jisyyji = Cells(i + 1, 122 + h)
  caunter = Application.Count(Range(Cells(12, retu_1), Cells(500, retu_1))) + 1
  Cells(10, retu_1) = caunter
  Cells(caunter + 11, retu_1) = jisyyji
 Next j
  i = i + 1
  If i = 5001 Then Exit Do
Loop
Call saikeisanon '再計算をオンにする
Application.ScreenUpdating = True '画面変更on
Range("Dv11").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub nextketa_seiretu()   '桁別次数字を下並び出力表示する
Dim gokei_max As Integer
Dim i, ii, j, jj, k, start As Integer
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
   Call saikeisanoff '再計算を止めて計算を速くする
gokei_max = Cells(8, 126)
For i = 0 To 30
 motosuu = Cells(10, i + 126)
 Range(Cells(12, i + 126), Cells(12 + motosuu, i + 126)).Select '番号,
 Selection.Cut
 Cells(12 + gokei_max - motosuu, i + 126).Select
 ActiveSheet.Paste
Next i
Call saikeisanon '再計算を起動させる
End Sub
------------------------------ 
Sub nextotal_seiretu()   '番号,回号、間隔を下並び出力。
 Dim gokei_max As Integer
 Dim i, ii, j, jj, k, start As Integer
 Sheets("次数字").Select
   start = MsgBox("整列開始しますか?", vbYesNo)
   If start = vbNo Then End
   Call saikeisanoff '再計算を止めて計算を速くする
  gokei_max = Cells(10, 248)
For i = 0 To 27
  motosuu = Cells(13, i + 249)
  Range(Cells(16, i + 249), Cells(16 + motosuu, i + 249)).Select '番号,
  Selection.Cut
  Cells(16 + gokei_max - motosuu, i + 249).Select
  ActiveSheet.Paste
Next i
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub kiguu3_tyusyutu()
  Dim kai, i, ii, r, t, span, owari As Integer
Sheets("すとれ-と").Select
 i = 4
 Cells(3, 354) = Empty
 kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
 If kai = False Or kai = "" Then End
 Range("mf4:mh5000,mp4:mw5000").ClearContents
 owari = Cells(2, 13) + kai
 Cells(3, 354) = kai
 Call saikeisanoff '再計算を止めて計算を速くする
 Do Until Cells(i, 4) = ""
  For x = 0 To 2
 If Cells(i, 4 + x) / 2 = Int(Cells(i, 4 + x) / 2) Then
  Cells(i, 344 + x) = 0
 Else
  Cells(i, 344 + 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 2
  Select Case r '百,十,一,のデータ表示列位置の設定
   Case 0: span = 355 '百
   Case 1: span = 357 '十
   Case 2: span = 359 '一  
  End Select
Cells(i, span) = Application.CountIf(Range(Cells(4 + ii, r + 344), Cells(ii + kai + 3, r +   344)), 1)
Cells(i, span + 1) = Application.CountIf(Range(Cells(4 + ii, r + 344), Cells(ii + kai + 3, r + 344)), 0)
Next r
 If ii > 0 Then Cells(i - 1, 354) = ii
 i = i + 1
Next ii
 Call saikeisanon
End Sub
------------------------------ 
Sub 大小3_tyusyutu()
 Dim kai, i, ii, r, t, span, owari As Integer
 Sheets("すとれ-と").Select
 i = 4
 Cells(3, 374) = Empty
 kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
 If kai = False Or kai = "" Then End
Range("mj4:ml5000,nj4:np5000").ClearContents
  owari = Cells(2, 13) + kai
  Cells(3, 474) = kai
Call saikeisanoff '再計算を止めて計算を速くする
Do Until Cells(i, 4) = ""
 For x = 0 To 2
  If Cells(i, 4 + x) < 5 Then
 Cells(i, 348 + x) = 0
  Else
 Cells(i, 348 + 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 2
  Select Case r '千、百,十,一,のデータ表示列位置の設定
   Case 0: span = 375 '千百
   Case 1: span = 377 '千百
   Case 2: span = 379 '千十
  End Select
 Cells(i, span) = Application.CountIf(Range(Cells(4 + ii, r + 348), Cells(ii + kai + 3, r + 348)), 1)
Cells(i, span + 1) = Application.CountIf(Range(Cells(4 + ii, r + 348), Cells(ii + kai + 3, r + 348)), 0)
Next r
 If ii > 0 Then Cells(i - 1, 374) = ii
 i = i + 1
Next ii
 Call saikeisanon
End Sub
------------------------------ 

Sub hotnum3_color() 'ホットナンバー色付け 同時に3ヶ所を行う
Dim maruiti As Range
Dim gyou, retu, stretu, deme As Integer


Worksheets("原本").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu = 5 Then stretu = 16
If retu = 6 Then stretu = 26
If retu = 7 Then stretu = 36
deme = Cells(gyou, retu)          
If retu <= 4 Or retu >= 8 Then End
deme_iti = Cells(gyou, retu) + 77


If Cells(gyou, retu) > 4 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092543
.TintAndShade = 0
.PatternTintAndShade = 0
End With   
End If


Set maruiti = Application.Cells(gyou, deme_iti)    
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.ColorIndex = 53 


If retu = 6 Or retu = 7 Then 
Cells(gyou, retu + 95).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092543
.TintAndShade = 0
.PatternTintAndShade = 0
End With 
End If


Worksheets("すとれ-と").Select
Cells(gyou + 1, deme + stretu).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Underline = xlUnderlineStyleSingle
Worksheets("原本").Select 
Cells(gyou, retu + 164) = Cells(gyou, retu) 


j = 1     


Do Until Cells(gyou + j, retu) = deme  
If j > 3 Then Exit Do
j = j + 1
Loop
Cells(gyou + j, retu).Select        
End Sub




2.No.3 分析

Sub pear_suji()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を出力。
Dim j, k, i, Maxx, yretu, loopend As Integer
Worksheets("二桁").Range("a21").Select
kaigo = Worksheets("原本").Cells(1, 12).Value
Sheets("二桁").Select
Cells(18, 2) = kaigo
loopend = kaigo + 50
 Range("r21:ms1000").ClearContents '出力表示部のクリア
Call saikeisanon
Range("n21") = "=CONCATENATE(原本!E3,原本!F3)"
Range("o21") = "=CONCATENATE(原本!E3,原本!G3)"
Range("p21") = "=CONCATENATE(原本!F3,原本!G3)"
Range("n21:p21").Copy Range(Cells(22, 14), Cells(50 + kaigo, 16))
Call saikeisanoff '再計算を止めて計算を速くする
i = 21
yretu = 0
Do Until Cells(i, 14) = ""
Cells(i, 13) = i - 20 '計算の為の回号表示する。
 For n = 1 To 3 '百十、百一、十一に分ける。
   setretu = Cells(i, 13 + n).Value '当選番号によりデータ記入位置を設定する。
       Select Case n '百十、百一、十一のデータ表示列位置の設定
     Case 1: span = 0 '百十
           Case 2: span = 120 '百一
          Case 3: span = 240 '十一
      End Select
yretu = 18 + setretu + span
caunter = Application.CountA(Range(Cells(21, yretu), Cells(120, yretu))) '記入位置をカウンタから計算する。
   Cells(21 + caunter, yretu) = Cells(i, 13) '回号データを記入する。
 If caunter = 0 Then '回号データの間隔を150行から記入する
 Cells(150 + caunter, yretu) = Cells(i, 13)
Else
 Cells(150 + caunter, yretu) = Abs(Cells(20 + caunter, yretu) - Cells(21 + caunter, yretu))
End If
Cells(i, 359) = Cells(i, 16) 'ミニ
Cells(i, 360) = Cells(150 + caunter, yretu) 'ミニ間隔
Cells(250 + caunter, yretu) = Worksheets("原本").Cells(i - 18, 4)  '番号データをを250行から記入する。
  Cells(19, yretu) = caunter + 1 '合計カウンタを計算表示する
If kaigo = Cells(i, 13) Then
For k = 1 To 100 '最終当選間隔計算
Maxx = kaigo - Application.Max(Range(Cells(21, 17 + k + span), Cells(74, 17 + k + span)))
Cells(18, 17 + k + span) = Maxx
Next k
End If
  Next n
i = i + 1
If i = loopend Then Exit Do
Loop
Range("R18:DM19").Select 'まとめてコピーする。自動記録マクロで作成
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
   Range("EH18:IC19").Select
Application.CutCopyMode = False
Selection.Copy
Range("F23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
    Range("IX18:MS19").Select
Application.CutCopyMode = False
Selection.Copy
Range("J23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.ScrollColumn = 13
Range("B20").Select
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub pear_suji_seiretu()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を下並びで整列して出力。時間が掛かるw
Dim j, k, i, Maxx, n, nn As Integer
 Sheets("二桁").Select
   Call saikeisanoff '再計算を止めて計算を速くする
 i = 21
For n = 1 To 3 '百十、百一、十一に分ける。
setretu = Cells(i, 13 + n).Value '番号によりデータ記入位置を設定する。
   Select Case n '百十、百一、十一のデータ表示列位置の設定
   Case 1: span = 18 '百十
     Case 2: span = 138 '百一
    Case 3: span = 258 '十一     
End Select
    Maxx = Application.Max(Range(Cells(19, span), Cells(19, span + 100)))
For nn = 0 To 99
  motosuu = Cells(19, nn + span)
  If Cells(19, 18) = "" Then End
If Maxx > motosuu Then
  Range(Cells(21, nn + span), Cells(Maxx - motosuu + 20, nn + span)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
 Next nn
Next n
Range("q21").Select
Call 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
   setretu = Cells(i, 2).Value
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
   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 nmbers3()'クイックピック
Randomize
Range("a1:b10").Select
Selection.ClearContents
count_5 = 0
For i = 1 To 3
    kai = Int(Rnd() * 10)
 Cells(i, 1) = kai
    Range("c1") = "=count(a1:a10)"
Next i
Range("g10:i10") = kai
   Range("A1:A3").Select
Selection.Copy
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub mini_kankaku() 'ミニ、間隔、回号記入、太字にする
     Dim moji As Range
     Dim  gosel As Integer

      gosel = Cells(18, 2).Value
       Range("MW25").Select
      Selection.Copy
      Range(Cells(26, 361), Cells(gosel + 20, 361)).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
       
     Cells(gosel + 20, 360).Select
      retu = ActiveCell.Column
      gyou = ActiveCell.Row
     Cells(gyou, 358) = gyou - 20
    
     If Cells(gyou, 361) = 1 Then  '記入セルを太字にする
      Set moji = Application.Cells(gyou, 362)
      moji.Font.Bold = True
     Else
      Set moji = Application.Cells(gyou, 363)
        moji.Font.Bold = True
     End If
        
End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 下揃え()
    Range("D2:D6").Select
Selection.Cut
Range("D6").Select
ActiveSheet.Paste
End Sub
---------------------------------------------------------------------------
Sub pear_suuji_3()   'ペア数字
j = 0
i = 21
k = 0
d = 0
Sheets("二桁").Select
patann = 0
Call saikeisanon
Range("ns21:pu5000").ClearContents
kaigo = Worksheets("原本").Cells(1, 12).Value
Range("nm21") = "=LEFT(原本!CO3,2)"
Range("nn21") = "=LEFT(原本!CO3,1)&RIGHT(原本!CO3,1)"
Range("no21") = "=RIGHT(原本!CO3,2)"
Range("nm21:no21").Copy Range(Cells(22, 377), Cells(20 + kaigo, 379))
  Call saikeisanoff
Do Until Cells(i, 377) = ""
    For j = 1 To 3 '出目の入力348
      d = Cells(i, j + 376).Value
If d >= 0 And d <= 9 Then
   k = 1
ElseIf d >= 11 And d <= 19 Then
 k = 0
ElseIf d >= 22 And d <= 29 Then
  k = -2
ElseIf d >= 33 And d <= 39 Then
  k = -5
ElseIf d >= 44 And d <= 49 Then
  k = -9
ElseIf d >= 55 And d <= 59 Then
  k = -14
ElseIf d >= 66 And d <= 69 Then
  k = -20
ElseIf d >= 77 And d <= 79 Then
  k = -27
ElseIf d >= 88 And d <= 89 Then
  k = -35
ElseIf d = 99 Then
k = -44
Else
k = 0
End If
  Cells(i, 382 + k + d) = Cells(i, 376 + j)
Next j
    i = i + 1
    If i = 4001 Then Exit Do
Loop
Call saikeisanon
  Range("ns6").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub nextnumber()'桁別の次回の番号表示する。
Dim nenum(3) As String
Dim stopnum As Integer
Call saikeisanon
  Sheets("次数字").Select
kaigo = Application.InputBox("開始回号番号入力して下さい")
If kaigo <= 0 Then End
kaigo = kaigo + 11
Range(Cells(kaigo, 6), Cells(kaigo + 2000, 105)).ClearContents '出力表示部のクリア
    With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
stopnum = Cells(10, 1) + 1
Range("e12").Select
Range("b12") = "=原本!E3&原本!E4"
Range("c12") = "=原本!f3&原本!f4"
Range("d12") = "=原本!g3&原本!g4"
Range("e12") = "=原本!d4"
Range("b12:e12").Copy Range(Cells(13, 2), Cells(stopnum + 10, 5))
  Call saikeisanon
    i = kaigo
Call saikeisanoff '再計算を止めて計算を速くする
Do Until Cells(i, 1) = stopnum
For n = 1 To 3 '百十一に分ける。
  setretu = Cells(i, 1 + n).Value '番号によりデータ記入位置を設定する。
  Cells(i, setretu + 6) = Cells(i, 1 + n)
  nenum(n) = Cells(i, 1 + n)
If n = 1 Then
Cells(i, setretu + 6).Select
With Selection.Font
.Color = -16776961
  End With
ElseIf n = 2 Then
Cells(i, setretu + 6).Select
With Selection.Font
.Color = -11489280
  End With
If nenum(n - 1) = nenum(n) Then
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
End With
End If
Else
Cells(i, setretu + 6).Select
With Selection.Font
.ThemeColor = xlThemeColorAccent6
End With
If nenum(n - 1) = nenum(n) Or nenum(n - 2) = 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 '再計算をオンにする
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

1.No.3 分析

Dim hit_m(10000, 3) As String
Dim kiguu(10000, 3) As String '奇数偶数3桁用文字配列変数
Dim hit(10000, 3) As Integer ’出目3桁用整数配列変数
Dim hitx(10000, 3) As Integer
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

あたまに ' がついた式は実行されない。(緑色部分)
'当選番号は文字として入力、3つに分けて合計、出目から大小や奇数遇数判定
’回号から間隔算出

Sub patapata_3() 'ボックス当選数字パターン貼付け
Dim i, j, dai, lastkai As Integer ’整数変数
Dim daida As String  '文字変数
Sheets("原本").Select  'シートを選択する。選択しない場合他のシートで実行された時は  問題発生危険あり。
lastkai = Cells(1, 12) + 3 '12列目1行目の=SUBTOTAL(2,E3:E5000)と+3で最終回算出
                   'Cells(行, 列)でセルの番地指定、行, 列には変数を入れ変化に対応させる。

    start = MsgBox("開始しますか?", vbYesNo)
If start = vbNo Then End '開始しないで終了する
  saikeisanoff '再計算止めて処理スピード上げる
Range("by3:cj5000").ClearContents ’この範囲をクリア(消す)する。
  Erase hit '変数の内容を消す
Range(Cells(3, 4), Cells(lastkai, 4)).Select 'セルD3~最終回まで複数セル選択する。
Selection.Copy ’選択部をコピー、マクロ自動記録で作成
 Range("BX3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
  i = 3 ’3行目から開始する
Do Until Cells(i, 7) = "" '7列目の3行目からデータの終わり行までカウンターとして以下の処理をする 空行の場合処理終了する。
     dai = 0 '大小判定用変数を0にする。
   For j = 1 To 3 ’3桁分の処理を繰り返す(jを1~3回までForからNextの間)
    hit(i - 1, j) = Cells(i, j + 4) ’セル5から7列目の3行目からデータを変数に格納する。3桁を1桁づつに計算式で分解しておく。
    If hit(i - 1, j) >= 5 Then dai = dai + 1 ’出目5以上を計算する。
    kiguu(i - 1, j) = Cells(i, j + 8) ’Cells(i, j + 8)のiは i=i+1で1ケづつ処理
   If kiguu(i - 1, j) = "偶" Then kiguu(i - 1, j) = "▲" Else kiguu(i - 1, j) = "△" ’奇数偶数
   If j = 3 Then
    Cells(i, 91) = kiguu(i - 1, 1) + kiguu(i - 1, 2) + kiguu(i - 1, 3)’奇数偶数パターン表示する
   End If
 Next j
   Select Case dai
     Case 0 ’daiの値0で文字変数daida に "■■■" を入れる。           
      daida = "■■■" ’4以下3つを表す
     Case 1
      daida = "■■□" ’4以下2つ’5以上1つ
     Case 2
      daida = "■□□" ’4以下1つ’5以上3つ
     Case 3
      daida = "□□□" ’5以上3つ
   End Select
     Cells(i, 89) = daida 'i行89列に大小(■□)記号を入力する。
  If i = 5000 Then Exit Do ’Do Until Cells(i, 7) = "" からLoopのストッパーとする
    i = i + 1 ’iは3+1で4になる。その後1ケづつ増えて行く
   k = i
Loop  ’Do Until Cells(i, 7) = "" からLoopの間繰り返しの処理をする。
   witi = 77
For i = 2 To k - 2 ’出目に応じた位置にマークする。 
 For j = 1 To 3
   If Cells(i + 1, witi + hit(i, j)) = "" Then ’出目0の時77+0で77列
      Cells(i + 1, witi + hit(i, j)) = "●"  ’シングルを表す
   ElseIf Cells(i + 1, witi + hit(i, j)) = "●" Then
     Cells(i + 1, witi + hit(i, j)) = "◎" ’ダブル
     Cells(i + 1, witi + 11) = 2 ’ダブル
  ElseIf Cells(i + 1, witi + hit(i, j)) = "◎" Then
     Cells(i + 1, witi + hit(i, j)) = "☆" ’トリプル
     Cells(i + 1, witi + 11) = 3 ’トリプル
  End If
 Next j
Next i
saikeisanon
 Call box_3 'サブプログラムSub box_3()呼び出すCallは無くても良い
 Call 当選番号表示
 Call 入力へ
End Sub
------------------------------------------
Sub box_3()
     saikeisanoff
    Dim moji(5000) As String
    Dim gogucara, minigogucara, mini2gogucara, minipgogucara As Object
    Dim rencyan As Integer
    Erase hit_m
i = 3
Do Until Cells(i, 5) = ""
  For j = 1 To 3
     hit(i - 2, j) = Cells(i, j + 4)
  Next j
For k = 1 To 2
  For j = 1 To 2 '数字の大小を判断する。
    If hit(i - 2, j) > hit(i - 2, j + 1) Then
       daisyou = hit(i - 2, j)
       hit(i - 2, j) = hit(i - 2, j + 1)
      hit(i - 2, j + 1) = daisyou
    End If
  Next j
Next k
For j = 1 To 3 '小さい順にボックス数字とする。
      moji(i) = Trim(moji(i)) + Trim(Str(hit(i - 2, j)))
   If j = 3 Then
     Cells(i, 93) = moji(i)
     Cells(i, 94) = Application.CountIf(Range(Cells(2, 93), Cells(i, 93)), Cells(i, 93))
   End If
 Next j
 If i = 5000 Then Exit Do
   i = i + 1
  For x = 1 To 10 '連荘数
     If Cells(i + 1, 76 + x) <> "" And Cells(i + 2, 76 + x) <> "" Then
           rencyan = rencyan + 1
     End If
  Next x
    If rencyan > 0 Then Cells(i + 2, 87) = rencyan
   rencyan = 0
Loop
Cells(i, 26).Select
saikeisanon
End Sub   
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
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
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub patapata_30() 'ストレート当選数字パターン貼付け
Dim hitx(5000, 4), i, j As Integer
If Cells(2, 13) > Sheets("原本").Cells(1, 24) Then MsgBox ("原本フィルター戻して下さい?"): End
start = MsgBox("ストレートパターン開始しますか?", vbYesNo)
  If start = vbNo Then End
   Sheets("原本").Select
    lastkai = Cells(1, 12) + 2
     Range(Cells(3, 4), Cells(lastkai, 4)).Select
     Selection.Copy
    Sheets("すとれ-と").Select
Range("c4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call saikeisanoff
Erase hitx: i = 0: j = 0
   i = 4
Do Until Cells(i, 3) = ""
 For j = 1 To 3 '桁別に
  Select Case j
 Case 1: span = 16’百桁
 Case 2: span = 26’十桁
 Case 3: span = 36’一桁
  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 3
    Cells(l + 3, hitx(l, m)) = "●"
 Next m
Next l
Call saikeisanon
     Call 入力へ
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 = 2000 Then Exit Do
   i = i + 1
Loop
If i = 0 Then MsgBox "データ等をチェックして下さい。": End
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub mini_kensaku()
Dim hani, kaigo, gyou, iti, retu As Integer
Sheets("ミニ出現数 ").Select
  Range("B3:b103").Select
  kaigou = Cells(1, 2)
mino = Worksheets("原本").Cells(kaigou + 2, 6) & Worksheets("原本").Cells(kaigou + 2, 7)
  bango = Application.InputBox("番号入力して下さい", Default:=mino)
If Len(bango) > 2 Then MsgBox ("2桁?"): 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'現在の行
  iti = Cells(gyou, 3) + 4
Range(Cells(gyou, iti), Cells(gyou, iti)).Select
 kaigo = Application.InputBox("回号入力して下さい", Default:=kaigou)
 start = MsgBox("開始しますか?", vbYesNo)
   If start = vbNo Then End
   Cells(gyou, iti) = kaigo
   hani = kaigo - Cells(gyou, iti - 1) '前回からの間隔で色付けする。
If hani <= 50 Then ’50回以下
   Cells(gyou, iti).Select
   Selection.Font.ColorIndex = 10 '緑4
ElseIf hani > 50 And hani <= 100 Then
   Cells(gyou, iti).Select
   Selection.Font.ColorIndex = 1 '青53=茶黒1
ElseIf hani >= 101 And hani <= 300 Then
  Cells(gyou, iti).Select
  Selection.Font.ColorIndex = 3 '赤
ElseIf hani > 300 Then
  Cells(gyou, iti).Select
  Selection.Font.ColorIndex = 3 '赤
  Selection.Font.Bold = True
End If
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 空白除去()
Dim x, i, k As Integer
Sheets("すとれ-と").Select
Range("db4:ee1000").ClearContents
saikeisanoff
For x = 1 To 30
   i = 0: k = 0
  Do Until Cells(4 + i, 3) = ""
   If Cells(4 + i, 61 + x) <> "" Then
       Cells(4 + i - k, 105 + x) = Cells(4 + i, 61 + x)
   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 後飛び記入() '記入する行をクリックした後マクロ実行する。
   gyou = ActiveCell.Row
  If gyou <= 3 Or Cells(gyou, 16) <> "" Then End
For i = 1 To 40
 If Cells(gyou, 15 + i) <> "●" Then
   Cells(gyou, 15 + i) = Cells(gyou - 1, 15 + i) + 1
 ElseIf Cells(gyou - 1, 15 + i) = "●" Then
  Cells(gyou, 15 + i) = 1
 End If
Next i
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 飛び記入_3() '記入する行をクリックした後マクロ実行する。
retu = ActiveCell.Column
gyou = ActiveCell.Row
For i = 0 To 30
If Cells(gyou - 1, 16 + i) = "●" Then
  If Cells(gyou, 16 + i) = "" Then Cells(gyou, 16 + i) = 1
Else
  If Cells(gyou, 16 + i) = "" Then Cells(gyou, 16 + i) = Cells(gyou - 1, 16 + i) + 1
End If
Next i
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub gokei_color()  '合計変化(右側線)=上昇-赤色、下降-黒色、同じー点線
Dim retu As Integer
saikeisanoff
ActiveWorkbook.Worksheets("原本").Select
  gyou = ActiveCell.Row
  retu = ActiveCell.Column '90,103
 If gyou <= 2 Then End
i = 1
Do Until Cells(i + gyou, retu) = ""
  saki = Cells(i + gyou - 1, retu)
 If saki = Cells(i + gyou, retu) Then
   Cells(i + gyou, retu).Select
   With Selection.Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .Weight = xlHairline
 End With
ElseIf saki < Cells(i + gyou, retu) Then
  Cells(i + gyou, retu).Select
  With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 10
 End With
ElseIf saki > Cells(i + gyou, retu) Then
     Cells(i + gyou, retu).Select
  With Selection.Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = xlAutomatic
  End With
End If
   i = i + 1
If i = 5000 Then Exit Do
Loop
If retu = 90 Then
 retu = 105
ElseIf retu = 105 Then
 retu = 106
End If
 Cells(gyou, retu).Select
 saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton1_Click()
If patann = 0 Then MsgBox ("選択して下さい"): Exit Sub
Unload UserForm1 'ユーザーホームを閉じる
Exit Sub
End Sub
---------------------------
Private Sub CommandButton2_Click()
End
End Sub
---------------------------
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then patann = 1
End Sub
---------------------------
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then patann = 2
End Sub
---------------------------
Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then patann = 3
End Sub
---------------------------
Private Sub OptionButton5_Click()
End Sub
---------------------------
Private Sub TextBox2_Change()
End Sub
---------------------------
Private Sub TextBox3_Change()
End Sub
---------------------------
Private Sub UserForm_Click()
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 tyusyutu_3() '回数間隔ごとに桁別出現
Dim kai, i, ii, r, t, span, owari As Integer
Sheets("すとれ-と").Select
Range("kc4:lg3737").ClearContents
    Cells(3, 289) = Empty
i = 4
kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
If kai = False Or kai = "" Then End
owari = Cells(2, 13) + kai
Cells(3, 289) = kai
Call saikeisanoff '再計算を止めて計算を速くする
For ii = 0 To owari Step kai
  For r = 0 To 2
    Select Case r '百,十,一,のデータ表示列位置の設定
      Case 0: span = 290 '百
      Case 1: span = 300 '十
     Case 2: span = 310 '一
   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, 289) = ii
  i = i + 1
Next ii
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                    
Sub 回別スペース集計() '回数間隔ごとに出現集計
Dim kai, i, ii, r, t, span, owari As Integer
     Sheets("原本").Select
Range("mk3:mu3737").ClearContents
    Cells(1, 349) = Empty
 i = 3
 kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
 If kai = False Or kai = "" Then End
 owari = Cells(1, 12) + kai
 Cells(1, 349) = kai & " 回毎"
 Call saikeisanoff '再計算を止めて計算を速くする
For ii = 3 To owari Step kai
 For t = 0 To 9
    Cells(i, t + 350) = Application.CountIf(Range(Cells(ii, 106), Cells(ii + kai - 1, 106)), t)
 Next t
  If ii > 3 Then Cells(i - 1, 349) = ii - 3
  i = i + 1
Next ii
  Call saikeisanon '再計算を設定する。
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                            
Sub ST後追い集計_3()
Sheets("すとれ-と").Select
Range("oi5:or14").Select
Selection.ClearContents
Range("oa15") = "=d4"
Range("ob15") = "=d5"
Range("oc15") = "=e4"
Range("od15") = "=e5"
Range("oe15") = "=f4"
Range("of15") = "=f5"
Range("oa15:of15").Select
Selection.Copy
Range("oa16:of3806").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Call saikeisanoff
    ii = 0
For ii = 0 To 4
    j = 0
 For i = 1 To 3
     x = Cells(15 + ii, i + 390 + j)
     y = Cells(15 + ii, i + 391 + j)
    Cells(y + 5, x + 399) = Cells(y + 5, x + 399) + 1
    j = j + 1
 Next i
   Cells(2, 399) = ii + 1
Next ii
 Call saikeisanon
 Range("oh4").Select
End Sub
ーーーーーーーーーーーーーーーー

Sub deme_uesita_3()’出目を指定後上下の出目を出す
Dim deme, j, i, kaigou, gyou_deme, retu_deme As Integer
 Worksheets("すとれ-と").Select
kaigou = Cells(2, 13)
Range("pp4:ps5000").Select
Selection.ClearContents
Range(Cells(4, 4), Cells(3 + kaigou, 7)).Select
Selection.Copy
Range("pk4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
   deme = Cells(2, 433)
   i = 1
Do Until Cells(3 + i, 429) = ""
  For j = 1 To 3
    If Cells(4 + i, 426 + j) = deme Then
  Cells(3 + i, 431 + j) = Cells(3 + i, 426 + j)
       Cells(4 + i, 431 + j) = deme
       Cells(5 + i, 431 + j) = Cells(5 + i, 426 + j)
    End If
  Next j
    i = i + 1
   If i > 5000 Then Exit Do
Loop
Cells(i - 7, 431).Select
End Sub