趣味のエクセルマクロ

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

2.ナンバーズ4パターン表作成関係エクセルマクロ(2)


 Sub s_b_copy() ’上の表の右端と同じデータ(box番号)を探し下端コピーする
 Dim gyou As Integer
Sheets("欠け算並び").Select
gyou = Cells(1, 2) + 1
 saikeisanon
Range("b9") = "=VALUE(パターン表!Q3)"
Range("c9") = "=VLOOKUP(B9,$E$8:$I$10011,5,0)"
Range("d9") = "=VLOOKUP(B9,$E$8:$I$10011,3,0)"
Range("b9:d9").Copy Range(Cells(10, 2), Cells(gyou, 4))
Range(Cells(10, 2), Cells(gyou, 4)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 saikeisanoff
Sheets("パターン表").Select
Range(Cells(2, 17), Cells(gyou, 17)).Select
Selection.Copy
Sheets("欠け算並び").Select
Range("J8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("z8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("パターン表").Select
Range(Cells(2, 83), Cells(gyou, 83)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("欠け算並び").Select
  Range("BT8").Select
ActiveSheet.Paste
saikeisanon
Cells(gyou + 6, 72).Select
 Call kakezancopy ’マクロkakezancopy実行する
End Sub
--------------------------------------------------------------------------------------------------------
Sub kakezancopy()
 Dim i, k, gyou As Integer
 Dim boxspan As String
 Sheets("欠け算並び").Select
 gyou = ActiveCell.Row
 If ActiveCell.Column <> 72 Then End
 If Cells(gyou, 72) = 0 Then End
   boxspan = Cells(gyou, 72)
 Application.ScreenUpdating = False '画面変更をしない。処理速度上げるため。
  i = 1
Do Until boxspan = Cells(gyou - i, 72) ’上の行に向かって同じ番号を探す
 i = i + 1
 If i = 4000 Then Exit Do
Loop
 Range(Cells(gyou - i, 11), Cells(gyou - i, 23)).Select
 Selection.Copy
 Cells(gyou, 11).Select
 ActiveSheet.Paste
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Range(Cells(gyou - i, 27), Cells(gyou - i, 71)).Select
 Selection.Copy’欠け算表をコピー
 Cells(gyou, 27).Select
   Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Range(Cells(gyou - i, 89), Cells(gyou - i, 95)).Select
 Selection.Copy
 Cells(gyou, 89).Select
 Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Cells(gyou - i, 72).Select
 Selection.Copy
 Cells(gyou, 72).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Application.ScreenUpdating = True '画面変更。
 Cells(gyou, 72).Select
End Sub
--------------------------------------------------------------------------------------------------------
Sub kankaku_sain() '太字と下線を引く
Dim maruiti As Range
Sheets("23桁").Select
 retu = ActiveCell.Column
 gyou = ActiveCell.Row
 san_keta = Cells(gyou, retu)
For i = 1 To 28
 If Cells(gyou, i + 15) = san_keta Then Exit For
Next i
 Set maruiti = Application.Cells(gyou, i + 15)
  maruiti.Font.Underline = xlUnderlineStyleSingle
  maruiti.Font.Bold = True
End Sub
--------------------------------------------------------------------------------------------------------
Sub ban_go3x() '判定番号位置欄に移動する
  Dim bango As String
bango = Application.InputBox("小さい順に番号入力して下さい")
start = MsgBox("開始しますか?", vbYesNo)
If start = vbNo Then Range("jk3:jj3").Select: End
Range("jl3:rw3").Select
Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
End Sub
--------------------------------------------------------------------------------------------------------
Sub GO_2桁()
   ActiveWindow.ScrollColumn = 557
Range("UQ2").Select
End Sub
ーーーーーーーーーーーーーーー
Sub 欠け算並びへ()
Sheets("欠け算並び").Select
jp = Cells(1, 2) + 7
Cells(jp, 2).Select
End Sub
ーーーーーーーーーーーーーーーー
Sub 順位裏復活へ()
Sheets("順位裏復活").Select
End Sub
---------------------------------------
Sub n23桁へ()
Sheets("23桁").Select
End Sub
ーーーーーーーーーーーーーーーー
Sub パターン表へ()
Sheets("パターン表").Select
End Sub
--------------------------------------------------------------------------------------------------------
Sub pear_suujikai()   'ペア数字
Dim j, i, k, retu As Integer
   j = 0
  i = 4
  k = 0
retu = 0
Sheets("23桁").Select
Range("a4:a6000").Copy
Range("yv4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
   patann = 0
        Call saikeisanon
     kaigo = Cells(1, 1) + 5
Range("ze4:abg6000").ClearContents
Range("yw4") = "=LEFT(B4,1)&MID(B4,2,1)"
Range("yx4") = "=LEFT(B4,1)&MID(B4,3,1)"
Range("yy4") = "=LEFT(B4,1)&MID(B4,4,1)"
Range("yz4") = "=MID(B4,2,1)&MID(B4,3,1)"
Range("za4") = "=MID(B4,2,1)&MID(B4,4,1)"
Range("zb4") = "=MID(B4,3,1)&MID(B4,4,1)"
Range("yw4:zb4").Copy Range(Cells(5, 673), Cells(kaigo, 678))
     Call saikeisanoff
   UserForm4.Show 'ユーザーホームを開く
Do Until Cells(i, 673) = ""
   For j = 1 To 6 '出目の入力348
      d = Cells(i, j + 672).Value
If d >= 11 And d <= 19 Then
 k = -1
ElseIf d >= 22 And d <= 29 Then
 k = -3
ElseIf d >= 33 And d <= 39 Then
 k = -6
ElseIf d >= 44 And d <= 49 Then
 k = -10
ElseIf d >= 55 And d <= 59 Then
 k = -15
ElseIf d >= 66 And d <= 69 Then
 k = -21
ElseIf d >= 77 And d <= 79 Then
 k = -28
ElseIf d >= 88 And d <= 89 Then
 k = -36
ElseIf d = 99 Then
 k = -45
Else
 k = 0
End If
  retu = d + 681 + k
If patann = 1 Then
   Cells(i, retu) = Cells(i, 15)
ElseIf patann = 2 Then
  Cells(i, retu) = Cells(i, j + 672)
ElseIf patann = 3 Then
  Cells(i, retu) = Cells(i, 672)
End If
Next j
   i = i + 1
  If i = 6000 Then Exit Do
Loop
Call saikeisanon
End Sub
---------------------------------------------------------------------------------------------------------
Private Sub CommandButton3_Click()
If patann = 0 Then MsgBox ("選択して下さい"): Exit Sub
Unload UserForm4 'ユーザーホーム4を閉じる
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
---------------------------------------------------------------------------------------------------------
Sub box_pear_total()   'ペア数字集計
Dim xx, ii, i, kai, owari As Integer
Sheets("23桁").Select
Call all_hyouji
i = 4
Range("BXj4:BZM6334").Select
Selection.ClearContents
Cells(3, 1986) = Empty
kai = Application.InputBox("集計間隔を入力して下さい", Default:=9)
Sheets("23桁").Select
Cells(3, 1986) = kai
Call saikeisanoff
owari = Cells(1, 1) + kai
For xx = 0 To 54
For ii = 0 To owari Step kai
  Cells(i, 1987 + xx) = Application.CountA(Range(Cells(4 + ii, 1908 + xx), Cells(ii + kai + 3, 1908 + xx)))
 If ii > 0 Then Cells(i - 1, 1986) = ii
i = i + 1
Next ii
i = 4
Next xx
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box_pear_total_kai()   'ペア数字集計
Dim xx, ii, i, kai, owari As Integer
Sheets("23桁").Select
Call all_hyouji
i = 4
Range("ace4:aeh6334").Select
Selection.ClearContents
Cells(3, 759) = Empty 'ace3
kai = Application.InputBox("集計間隔を入力して下さい", Default:=9)
start = MsgBox("開始しますか?", vbYesNo)
If start = vbNo Then End
Sheets("23桁").Select
Cells(3, 759) = kai 'ace3
Call saikeisanoff
owari = Cells(1, 1) + kai
For xx = 0 To 54
 For ii = 0 To owari Step kai
  Cells(i, 760 + xx) = Application.CountA(Range(Cells(4 + ii, 681 + xx), Cells(ii + kai + 3, 681 + xx)))
   If ii > 0 Then Cells(i - 1, 759) = ii
   i = i + 1
 Next ii
i = 4
Next xx
Call saikeisanon
End Sub
--------------------------------------------------------------------------------------------------------
Sub box_pear_total表示()    'ペア数字集計
patan = 0
UserForm5.Show 'ユーザーホームを開く
If patan = 1 Then
Call riset
Range( _
"BXK:BXK,BXU:BXU,BYD:BYD,BYL:BYL,BYS:BYS,BYY:BYY,BZD:BZD,BZH:BZH,BZK:BZK,BZM:BZM" _
).Select 'シングル表示
Range("Bxk1").Activate
Selection.EntireColumn.Hidden = True
End If
If patan = 2 Then
Call riset
Range("BXL:BXT,BXV:BYC,BYE:BYK,BYM:BYR,BYT:BYX,BYZ:BZC,BZE:BZG,BZI:BZJ,BZL:BZL" _
).Select 'ダブル表示
Range("BZL1").Activate
Selection.EntireColumn.Hidden = True
End If
Range("Bxk1").Activate
If patan = 3 Then
Call riset
End If
End Sub
--------------------------------------------------------------------------------------------------------
Sub box_pear_total表示_kai()    'ペア数字集計
patan = 0
UserForm5.Show 'ユーザーホームを開く
If patan = 1 Then
Call riset
Range( _
"acf:acf,acp:acp,acy:acy,adg:adg,adn:adn,adt:adt,ady:ady,aec:aec,aef:aef,aeh:aeh" _
).Select 'シングル表示
Range("Bxk1").Activate
Selection.EntireColumn.Hidden = True
End If
If patan = 2 Then
Call riset
Range("ACG:ACO,ACQ:ACX,ACZ:ADF,ADH:ADM,ADO:ADS,ADU:ADX,ADZ:AEB,AED:AEE,AEG:AEG" _
).Select 'ダブル表示
Range("AEG1").Activate
Selection.EntireColumn.Hidden = True
End If
Range("acg1").Activate
If patan = 3 Then
Call riset
End If
End Sub
--------------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
If patan = 0 Then MsgBox ("選択して下さい"): Exit Sub
Unload UserForm5 'ユーザーホームを閉じる
End Sub
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then patan = 1
End Sub
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then patan = 2
End Sub
Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then patan = 3
End Sub
-------------------------------------------------------------------------------------------------------
Sub riset()
Columns("BXJ:BZN").Select
Selection.EntireColumn.Hidden = False
End Sub
--------------------------------------------------------------------------------------------------------
Sub tripear_suuji()   'エタニティ数字
Dim j, i, k, d As Integer
j = 0
i = 4
k = 0
Sheets("23桁").Select
Range("B4:B6000").Select
Selection.Copy
  Range("AS4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 Call saikeisanoff
patann = 0
   Sheets("23桁").Select
UserForm1.Show 'ユーザーホームを開く
  Range("at4:je6000").Select
  Selection.ClearContents
Do Until Cells(i, 2) = ""
 For j = 1 To 4 '出目の入力348
  If Cells(i, j + 2).Value = "" Then Exit For
  d = Cells(i, j + 2).Value
 If d >= 0 And d <= 9 Then
  k = 0
ElseIf d >= 11 And d <= 19 Then
  k = -1
ElseIf d >= 22 And d <= 29 Then
  k = -3
ElseIf d >= 33 And d <= 39 Then
  k = -6
ElseIf d >= 44 And d <= 49 Then
  k = -10
ElseIf d >= 55 And d <= 59 Then
  k = -15
ElseIf d >= 55 And d <= 59 Then
  k = -15
ElseIf d >= 66 And d <= 69 Then
  k = -21
ElseIf d >= 77 And d <= 79 Then
  k = -28
ElseIf d >= 88 And d <= 89 Then
  k = -36
ElseIf d = 99 Then
  k = -45
ElseIf d >= 111 And d <= 119 Then
  k = -56
ElseIf d >= 122 And d <= 129 Then
  k = -58
ElseIf d >= 133 And d <= 139 Then
  k = -61
ElseIf d >= 144 And d <= 149 Then
  k = -65
ElseIf d >= 155 And d <= 159 Then
  k = -70
ElseIf d >= 166 And d <= 169 Then
 k = -76
ElseIf d >= 177 And d <= 179 Then
  k = -83
ElseIf d >= 188 And d <= 189 Then
  k = -91
ElseIf d = 199 Then
  k = -100
ElseIf d >= 222 And d <= 229 Then
  k = -122
ElseIf d >= 233 And d <= 239 Then
  k = -125
ElseIf d >= 244 And d <= 249 Then
  k = -129
ElseIf d >= 255 And d <= 259 Then
  k = -134
ElseIf d >= 266 And d <= 269 Then
  k = -140
ElseIf d >= 277 And d <= 279 Then
  k = -147
ElseIf d >= 288 And d <= 289 Then
  k = -155
ElseIf d = 299 Then
  k = -164
ElseIf d >= 333 And d <= 339 Then
  k = -197
ElseIf d >= 344 And d <= 349 Then
  k = -201
ElseIf d >= 355 And d <= 359 Then
  k = -206
ElseIf d >= 366 And d <= 369 Then
  k = -212
ElseIf d >= 377 And d <= 379 Then
  k = -219
ElseIf d >= 388 And d <= 389 Then
  k = -227
ElseIf d = 399 Then
  k = -236
ElseIf d >= 444 And d <= 449 Then
  k = -280
ElseIf d >= 455 And d <= 459 Then
  k = -285
ElseIf d >= 466 And d <= 469 Then
  k = -291
ElseIf d >= 477 And d <= 479 Then
  k = -298
ElseIf d >= 488 And d <= 489 Then
  k = -306
ElseIf d = 499 Then
  k = -315
ElseIf d >= 555 And d <= 559 Then
  k = -370
ElseIf d >= 566 And d <= 569 Then
  k = -376
ElseIf d >= 577 And d <= 579 Then
  k = -383
ElseIf d >= 588 And d <= 589 Then
  k = -391
ElseIf d = 599 Then
  k = -400
ElseIf d >= 666 And d <= 669 Then
  k = -466
ElseIf d >= 677 And d <= 679 Then
  k = -473
ElseIf d >= 688 And d <= 689 Then
  k = -481
ElseIf d = 699 Then
  k = -490
ElseIf d >= 777 And d <= 779 Then
  k = -567
ElseIf d >= 788 And d <= 789 Then
  k = -575
ElseIf d = 799 Then
  k = -584
ElseIf d >= 888 And d <= 889 Then
  k = -672
ElseIf d = 899 Then
  k = -681
ElseIf d = 999 Then
 k = -780
End If
If patann = 1 Then
  Cells(i, d + 46 + k) = Cells(i, 15)
ElseIf patann = 2 Then
  Cells(i, d + 46 + k) = Cells(i, j + 2)
ElseIf patann = 3 Then
  Cells(i, d + 46 + k) = Cells(i, 1)
End If
Next j
  i = i + 1
  If i = 6001 Then Exit Do
Loop
 Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub kankaku_cunters() '古いタイプ
retu = ActiveCell.Column
gyou = ActiveCell.Row
j = 0
i = 0
If Cells(gyou, retu) = "" Then End
For i = 1 To 777
 If Cells(gyou + i, retu) = "" Then
   j = j + 1
 Else
  Exit For
 End If
Next i
If retu > 66 And retu < 77 Then
  Cells(gyou + i - 1, retu) = j
End If
actsheet = ActiveSheet.Name
 If actsheet <> "パターン表" Then '元データをコピーする。
   MsgBox "間隔は " & (j)
 End If
 If i = 999 Then End
End Sub
--------------------------------------------------------------------------------------------------------
Sub kankaku_cunters2() '以前の間隔チェック
retu = ActiveCell.Column
gyou = ActiveCell.Row
  j = 0
  i = 0
  If Cells(gyou, retu) = "" Then End
For i = 1 To 777
 If Cells(gyou - i, retu) = "" Then
   j = j + 1
 Else
  Exit For
 End If
Next i
If retu > 66 And retu < 77 Then
   If Cells(gyou - 1, retu) <> "" Then End
   Cells(gyou - 1, retu) = j
End If
actsheet = ActiveSheet.Name
If actsheet <> "パターン表" Then '元データをコピーする。
  MsgBox "間隔は " & (j)
  Cells(gyou, retu + 7) = j
  Cells(gyou, retu + 7).Select
End If
 Cells(gyou - 1, 103) = ""
 Cells(gyou, 103) = "*"
 If i = 999 Then End
End Sub
--------------------------------------------------------------------------------------------------------
Sub kankaku_cunters22() '新しい間隔チェック2015.03.28
 retu = ActiveCell.Column
 gyou = ActiveCell.Row
  j = 0
  i = 0
For jj = 1 To 9 Step 2 '引っ張り0にする
 Cells(gyou, 180 + jj) = 0
Next jj
For ii = 1 To 10
  For i = 1 To 100
    If Cells(gyou - i, 66 + ii) = "" Then
      j = j + 1
   Else
     Exit For
   End If
  If Cells(gyou, 66 + ii) <> "" Then Cells(gyou - 1, 66 + ii) = j
 Next i
  j = 0
Next ii
End Sub
--------------------------------------------------------------------------------------------------------
Sub gokei_color()  '合計変化の色ずけ
Dim totalbar As Range
ActiveWorkbook.Worksheets("パターン表").Select
gyou = ActiveCell.Row
If gyou <= 2 Then End
i = 1
Do Until Cells(i + gyou, 80) = ""
 Set totalbar = Application.Cells(gyou, 80)
  saki = Cells(i + gyou - 1, 80)
 If saki = Cells(i + gyou, 80) Then
  Cells(i + gyou, 80).Select
  With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
 End With
ElseIf saki < Cells(i + gyou, 80) Then
 Cells(i + gyou, 80).Select
 With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 10 '.Color = 10
.TintAndShade = 0
.Weight = xlThin
 End With
ElseIf saki > Cells(i + gyou, 80) Then
     Cells(i + gyou, 80).Select
 With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
 End With
 Cells(i + gyou, 80).Select
End If
 i = i + 1
 If i = 6000 Then Exit Do
Loop
End Sub
--------------------------------------------------------------------------------------------------------
Sub total間隔() '合計間隔でアンダーバー引く
   Dim i, k, gyou, total As Integer
   Dim totalbar, dtotalbar As Range
Worksheets("パターン表").Select
 gyou = ActiveCell.Row
 If ActiveCell.Column <> 80 Then End
 total = Cells(gyou, 80)
Set dtotalbar = Application.Cells(gyou, 27)
Set totalbar = Application.Cells(gyou, 80)
   i = 1
 Do Until total = Cells(gyou - i, 80)
  i = i + 1
  k = i - 1
  If i = 3000 Then Exit Do
Loop
If total = 5 Then ’合計5の時  余り出ない合計4以下や33以上は計算しない。
  If k >= 180 And k < 356 Then frg = 1
  If k >= 356 Then frg = 2
End If
If total = 6 Then
 If k >= 120 Then frg = 1
 If k >= 238 Then frg = 2
End If
If total = 7 Then
 If k >= 84 Then frg = 1
 If k >= 168 Then frg = 2
End If
If total = 8 Then
 If k >= 62 Then frg = 1
 If k >= 122 Then frg = 2
End If
If total = 9 Then’合計9の時
 If k >= 45 Then frg = 1
 If k >= 91 Then frg = 2
End If
If total = 10 Then
 If k >= 35 Then frg = 1
 If k >= 71 Then frg = 2
End If
If total = 11 Then
 If k >= 28 Then frg = 1
 If k >= 57 Then frg = 2
End If
If total = 12 Then
 If k >= 24 And k < 48 Then frg = 1
 If k >= 48 Then frg = 2
End If
If total = 13 Then
 If k >= 20 Then frg = 1
 If k >= 41 Then frg = 2
End If
If total = 14 Then
 If k >= 18 Then frg = 1
 If k >= 37 Then frg = 2
End If
If total = 15 Then’合計15の時
 If k >= 17 Then frg = 1
 If k >= 34 Then frg = 2
End If
If total = 16 Then
 If k >= 16 Then frg = 1
 If k >= 32 Then frg = 2
End If
If total = 17 Then
 If k >= 15 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 18 Then ’合計18の時
 If k >= 15 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 19 Then
 If k >= 15 And k < 30 Then frg = 1
 If k >= 30 Then frg = 2
End If
If total = 20 Then
 If k >= 16 Then frg = 1
 If k >= 32 Then frg = 2
End If
If total = 21 Then
 If k >= 17 Then frg = 1
 If k >= 34 Then frg = 2
End If
If total = 22 Then
 If k >= 18 Then frg = 1
 If k >= 37 Then frg = 2
End If
If total = 23 Then
 If k >= 21 Then frg = 1
 If k >= 41 Then frg = 2
End If
If total = 24 Then
 If k >= 24 Then frg = 1
 If k >= 48 Then frg = 2
End If
If total = 25 Then
 If k >= 28 Then frg = 1
 If k >= 57 Then frg = 2
End If
If total = 26 Then
 If k >= 35 Then frg = 1
 If k >= 71 Then frg = 2
End If
If total = 27 Then
 If k >= 45 Then frg = 1
 If k >= 91 Then frg = 2
End If
If total = 28 Then
 If k >= 62 Then frg = 1
 If k >= 122 Then frg = 2
End If
If total = 29 Then
 If k >= 84 Then frg = 1
 If k >= 168 Then frg = 2
End If
If total = 30 Then
 If k >= 120 Then frg = 1
 If k >= 238 Then frg = 2
End If
If total = 31 Then
 If k >= 180 Then frg = 1
 If k >= 356 Then frg = 2
End If
If total = 32 Then’合計32
 If k >= 286 Then frg = 1
 If k >= 572 Then frg = 2
End If
If frg = 1 Then
 totalbar.Font.Underline = xlUnderlineStyleSingle
 dtotalbar.Font.Underline = xlUnderlineStyleSingle
ElseIf frg = 2 Then
 totalbar.Font.Underline = xlUnderlineStyleDouble
 dtotalbar.Font.Underline = xlUnderlineStyleDouble
Else
 totalbar.Font.Underline = xlUnderlineStyleNone
 dtotalbar.Font.Underline = xlUnderlineStyleNone
End If
' Cells(gyou + i, 80).Select
'  total間隔

End Sub
--------------------------------------------------------------------------------------------------------
Sub hotno_copy()
gocel = Cells(1, 2) + 10
Sheets("パターン表").Select
Range("R2:U5000").Select
Selection.Copy
Sheets("欠け算並び").Select
Range("eh10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(gocel, 138).Select
End Sub
--------------------------------------------------------------------------------------------------------
Sub kakezan_total()   '数字集計
Dim xx, ii, i, kai, owari As Integer
 Sheets("欠け算並び").Select
 i = 6
 Range("jz6:ls6334").Select
 Selection.ClearContents
Call saikeisanoff
 kai = Application.InputBox("集計間隔を入力して下さい", Default:=10)
 Cells(5, 286) = kai
 Application.ScreenUpdating = False '画面変更をしない。
 owari = Cells(1, 2) + kai
For xx = 0 To 45
 For ii = 0 To owari Step kai
Cells(i, 287 + xx) = Application.CountA(Range(Cells(8 + ii, 27 + xx), Cells(ii + kai - 1, 27 + xx)))
 If ii > 0 Then Cells(i - 1, 286) = ii
 i = i + 1
Next ii
i = 6
Next xx
Call saikeisanon
Application.ScreenUpdating = True '画面変更
End Sub