ムラゴン ホーム
2.ナンバーズ4パターン表作成関係エクセルマクロ（2）
Sub s_b_copy() ’上の表の右端と同じデータ（box番号）を探し下端コピーする
Dim gyou As long
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
ナンバーズ4 かけ算番号（～5144回）
--------------------------------------------------------------------------------------------------------
Sub kakezancopy()
Dim i As long, k As long, gyou As long
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 As long, i As long, k As long, retu As long
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 As long, ii As long, i As long, kai As long, owari As long
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 As long, ii As long, i As long, kai As long, owari As long
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 As long, i As long, k As long, d As long
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 As long, k As long, gyou As long, total As long
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 As long, ii As long, i As long, kai As long, owari As long
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