変数　知らなかった本当の使い方

Sub kiguu3間隔() '奇数偶数の間隔でアンダーバー引く
Dim i As long, k As long, gyou As long, kiguu As long
Dim kiguubar As Range , 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 As long, k As long, gyou As long, retu As long, deme As long
　Dim demebar As Range , 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 As long, k As long, gyou As long, total As long
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 As long, k As long, gyou As long, total As long, frg As long
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 As long, k As long, gyou As long, space As long, frg As long
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 As long, k As long, i As long, n As long, caunter As long, Maxx As long
Dim setretu As long, span As long, writretu As long

   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 As long, k As long, i As long, n As long, nn As long, caunter As long, Maxx As long
Dim  setretu As long, span As long, writretu As long
 Dim  kaigo As long, start As long, gyou As long
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 As long, k As long, x As long, n As long, nn As long, caunter As long
 Dim Maxx As long,setretu As long, span As long
Dim jwritretu As long, kaigo As long, startgyou As long, start As long, gyou As long

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 long
  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 As long, jisyyji As long, h As long, j As long, i As long
  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 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(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 long
 Dim i As long, ii As long, j As long, jj As long, k As long, start As long
 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 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, 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 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, 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 As long, retu As long, stretu As long, deme As long

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

変数　知らなかった本当の使い方 
Sub pear_suji()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を出力。
Dim j As long, k As long, i As long, Maxx As long
Dim  yretu As long, loopend As long

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()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を下並びで整列して出力。時間が掛かるｗ
Dim j As long, k As long, i As long, Maxx As long, n As long, nn As long
 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 long

      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 long

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

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

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

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

変数　知らなかった本当の使い方 - 趣味のエクセルで当てようロト・ナンバーズ

Sub patapata_3() 'ボックス当選数字ﾊﾟﾀｰﾝ貼付け
Dim i As long, j As long, dai As long, lastkai As long　’整数変数
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　'ｉ行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 As Object, minigogucara As Object
    Dim  mini2gogucara As Object, minipgogucara As Object
    Dim rencyan As long
    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) As long, i As long, j As long
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 As long, kaigo As long, gyou As long, iti As long, retu As long
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 As long, i As long, k As long
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 long
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 As long, i As long, ii As long, r As long, t As long, span As long, owari As long
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 As long, i As long, ii As long, r As long, t As long, span As long, owari As long
     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 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, 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