ムラゴン ホーム
N0.4予測パターン抽出
Sub box_kensaku() ’ナンバーズ4のボックス出現回数集計
Dim bango As String
On Error GoTo errorcheck
Sheets("box").Select
Range("B3:W65").Select
bango = Application.InputBox("box番号入力して下さい", Default:=Cells(1, 25))
Cells(1, 25) = bango
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
Range(Cells(gyou, retu + 1), Cells(gyou, retu + 1)).Select
res = MsgBox("集計しますか", vbYesNo)
If res = vbYes Then
Cells(gyou, retu + 1) = Cells(gyou, retu + 1) + 1’回数+1する。
End If
box_kensaku_3 ’サブルーチンに行く
Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
'MsgBox "エラー番号" & Err & ":" & Error(Err): End
End Sub
当選番号を小さい順に並べて手動でボックス番号にしているが？最初から当選番号を入力してマクロでボックス番号に変換したのが良い。当選番号は4桁の数字（ここでは文字としてる）だが、違った桁数や文字を受け付けない様にしたのが良いでしょうね。
もっとも、Range("B3:W65").Selectで指定した範囲に番号が無い場合受け付けないので問題は無いかも知れませんが？
----------------------------------------------------------------------------------
Sub box_kensaku_3()’前回のボックス番号を Default(規定値)として
Dim bango As String
Sheets("box").Select
On Error GoTo errorcheck
Range("Bh9:bh800").Select
bango = Application.InputBox("box番号入力して下さい", Default:=Cells(1, 25))
Cells(2, 25) = bango
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
Range(Cells(gyou, retu + 1), Cells(gyou, retu + 1)).Select
res = MsgBox("集計しますか", vbYesNo)
If res = vbYes Then
Cells(gyou, retu + 1) = Cells(gyou, retu + 1) + 1
End If
Call boxsort
Range("B3:W64").Select
Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub plas_1() 'ﾎﾞｯｸｽ間隔計算 789555
Sheets("boxリスト").Select
On Error GoTo errorcheck
boxx = InputBox("今回のbox は?", Default:=Sheets("box").Cells(1, 25))
Selection.AutoFilter Field:=26, Criteria1:=boxx, Operator:=xlAnd
Cells(1, 32) = Cells(1, 32) + 1 '次回表示
Columns("AE:AE").Select
Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
'MsgBox "エラー番号" & Err & ":" & Error(Err): End
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub stBoxx_Kensaku() ’ストレート番号を追加する準備
On Error GoTo errorcheck
'Static maeban
maeban = Cells(1, 1)
Range("B2:b1430").Select
boxx = InputBox("今回のbox は?", Default:=Sheets("box").Cells(1, 25))
maeban = boxx
Cells(1435, 1) = maeban
Selection.Find(What:=boxx, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
retu = ActiveCell.Column
gyou = ActiveCell.Row
Range(Cells(gyou, retu), Cells(gyou, retu)).Select
i = 0
Do Until Cells(gyou, 2 + i) = ""
i = i + 1
Range(Cells(gyou, 2 + i), Cells(gyou, 2 + i)).Select
If i = 40 Then Exit Do
Loop
Exit Sub
errorcheck:
MsgBox "エラー番号" & Err & ":" & Error(Err): End
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
変数 知らなかった本当の使い方
Sub ストレート() ' ストレート番号記入する。
Dim n_re As long, gyou As long, retu As long, Start As long, kai As long, k As long
Dim st_no As String
saikeisanoff
Sheets("要素かけ算").Select
st_no = Cells(2, Cells(1, 149) + 153)
Sheets("boxストレート").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
Start = MsgBox(st_no & "で入力しますか？", vbYesNo)
If Start = vbNo Then End
If Cells(gyou, retu) = "" Then Cells(gyou, retu) = st_no
kai = Application.CountIf(Range(Cells(gyou, 3), Cells(gyou, retu)), st_no)
k = 1
If kai >= 2 Then
Cells(gyou, retu).Select
Selection.Font.Bold = True
Do Until Cells(gyou, retu - k) = st_no
k = k + 1
If retu - k = 2 Then Exit Do
Loop
If k >= 1 And Cells(gyou, retu - k) = st_no Then
Cells(gyou, retu - k).Select
Selection.Font.Bold = True
End If
End If
saikeisanon
Cells(gyou + 1, retu).Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub yosoutennkai()
'当たる博士予測展開
' マクロ記録日 : 2007/3/2 "C:\Users\mk\Desktop\数字選択DTSK"
Sheets("boxリスト").Select
Range("AN10").Select
ChDir "C:\Users\mk\Desktop\数字選択DTSK"
f_name = Application.InputBox("ファイル名？数字のみ例213501")
f_name = "rn4" & f_name & ".txt"
Cells(2, 111) = f_name
namer = "C:\Users\mk\Desktop\数字選択DTSK\" & f_name
Workbooks.OpenText Filename:= _
namer, Origin:=932, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(4, _
1), Array(5, 2), Array(9, 2), Array(10, 2), Array(14, 2), Array(15, 2), Array(19, 2), Array( _
20, 2), Array(24, 2), Array(25, 2), Array(29, 2), Array(30, 2), Array(34, 2), Array(35, 2), _
Array(39, 2), Array(40, 2), Array(44, 2), Array(45, 2), Array(49, 2), Array(50, 2), Array( _
54, 2), Array(55, 2), Array(59, 2), Array(60, 2), Array(64, 2), Array(65, 2), Array(69, 2), _
Array(70, 2), Array(74, 2), Array(75, 2), Array(79, 1)), TrailingMinusNumbers:=True
Rows("51:80").Select
Selection.Copy
Range("C90").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub hakase_tenkai()
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(5, 1), Array(9, 1), Array(10, 1), _
Array(14, 1), Array(15, 1), Array(19, 1), Array(20, 1), Array(24, 1), Array(25, 1), Array( _
29, 1), Array(30, 1), Array(34, 1), Array(35, 1), Array(39, 1), Array(40, 1), Array(44, 1), _
Array(45, 1), Array(49, 1), Array(50, 1), Array(54, 1), Array(55, 1), Array(59, 1), Array( _
60, 1), Array(64, 1), Array(65, 1), Array(69, 1), Array(70, 1), Array(74, 1), Array(75, 1), _
Array(79, 1)), TrailingMinusNumbers:=True
Rows("51:60").Select
Selection.Copy
Range("K66").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.SmallScroll Down:=10
Application.CutCopyMode = False
Selection.ClearContents
Selection.ClearContents
Rows("51:60").Select
Selection.Copy
Range("J66").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("当たる展開").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("当たる展開").Sort.SortFields.Add Key:=Range("J66"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("当たる展開").Sort
.SetRange Range("J66:S16449")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 飛びコピー()
Windows("NO.4ST分析.xlsm").Activate
Sheets("飛び計").Select
Range("I2:I10001").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Range("Ad2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Ac2").Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub kesu()
Range("A2:A716").Select
Selection.ClearContents
Range("Al2:Am716").Select
Selection.ClearContents
Range("AJ2").Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub tbcopy()
Sheets("box飛").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
Range(Cells(gyou, 16), Cells(gyou, 25)).Select
Selection.Copy
Range("P2").Select '飛び計算元コピー
ActiveSheet.Paste
Range("P3:Y3").Select
Selection.Copy '色を消す
Range(Cells(gyou + 1, 16), Cells(gyou + 1, 25)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For i = 1 To 10
If Cells(gyou, 15 + i) = "●" Or Cells(gyou, 15 + i) = "◎" Then
If Cells(gyou + 1, 15 + i) <> "●" And Cells(gyou + 1, 15 + i) <> "◎" Then
Cells(gyou + 1, 15 + i) = 1
End If
End If
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub tbcopy_kai() ’飛び間隔と赤丸集計
Dim t As long, akamarukazu As long
Dim akamaruiti As Object
Sheets("box飛").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
'スライドコピーする。
Range(Cells(gyou - 1, 16), Cells(gyou, 25)).Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range(Cells(gyou - 1, 16), Cells(gyou + 1, 25)), Type:=xlFillDefault
Range(Cells(gyou - 1, 16), Cells(gyou + 1, 25)).Select
Range(Cells(gyou, 16), Cells(gyou, 25)).Select
Selection.Copy
Range("P2").Select '飛び計算元コピー
ActiveSheet.Paste
Range("P3:Y3").Select
Selection.Copy '色を消す
Range(Cells(gyou + 1, 16), Cells(gyou + 1, 25)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For i = 1 To 10
If Cells(gyou, 15 + i) = "●" Or Cells(gyou, 15 + i) = "◎" Then
If Cells(gyou + 1, 15 + i) <> "●" And Cells(gyou + 1, 15 + i) <> "◎" Then
Cells(gyou + 1, 15 + i) = 1
End If
End If
Next i
t = 0
For j = 1 To 10 '飛び合計計算
If Cells(gyou, 15 + j) = "●" And Val(Cells(gyou - 1, 15 + j)) >= 1 Then
t = t + Cells(gyou - 1, 15 + j)
ElseIf Cells(gyou, 15 + j) = "◎" And Val(Cells(gyou - 1, 15 + j)) >= 1 Then
t = t + Cells(gyou - 1, 15 + j) * 2
End If
Next j
Cells(gyou, 26) = t
akamarukazu = 0
For k = 16 To 25
Set akamaruiti = Application.Cells(gyou, k)
If akamaruiti.Font.Color = 255 Then akamarukazu = akamarukazu + 1
Next k
Cells(gyou, 27) = akamarukazu
Range("O4:AA4").Select
Selection.Delete Shift:=xlUp
Cells(gyou - 1, 16).Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub tbcopy2()
Sheets("box飛").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
Range(Cells(gyou, 16), Cells(gyou, 25)).Select
Selection.Copy
Range("P2").Select
ActiveSheet.Paste
Range("P3:Y3").Select
Selection.Copy
Range(Cells(gyou + 1, 16), Cells(gyou + 1, 25)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For i = 1 To 10
If Cells(gyou, 15 + i) = "●" Or Cells(gyou, 15 + i) = "◎" Then
If Cells(gyou + 1, 15 + i) <> "●" And Cells(gyou + 1, 15 + i) <> "◎" Then
Cells(gyou + 1, 15 + i) = 1
End If
End If
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub box_tyuusyutu()
Selection.AutoFilter Field:=29, Criteria1:="<>#N/A", Operator:=xlAnd
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub st_tyuusyutu()
Selection.AutoFilter Field:=33, Criteria1:="<>#N/A", Operator:=xlAnd
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 桁6copy()
Dim keta_1(100, 6) As long
Dim keta_2(10000, 6) As long
saikeisanoff
Windows("ｎｏ4各種分析.xls").Activate
Sheets("桁分析").Select
Range("C5").Select
For h = 1 To 6
For i = 1 To 100
keta_1(i, h) = Cells(4 + i, h * 4 - 1)
Next i
Next h
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xls").Activate
Sheets("万リスト").Select
For h = 1 To 6
For i = 1 To 100
Cells(1 + i, 36 + h) = keta_1(i, h)
Next i
Next h
saikeisanon
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub s_kesi()
Range("Ap2:BX777").Select
Selection.Delete Shift:=xlToLeft
Range("Ao2").Select
End Sub
-------------------------------------------------------
Sub box_kensaku()
Dim bango As String
On Error GoTo errorcheck
Sheets("box").Select
Range("B3:W64").Select
bango = Application.InputBox("box番号入力して下さい", Default:=Cells(1, 25))
Cells(1, 25) = bango
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
Range(Cells(gyou, retu + 1), Cells(gyou, retu + 1)).Select
res = MsgBox("集計しますか", vbYesNo)
If res = vbYes Then
Cells(gyou, retu + 1) = Cells(gyou, retu + 1) + 1
End If
box_kensaku_3
Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
'MsgBox "エラー番号" & Err & ":" & Error(Err): End
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub box_kensaku_2()
Range("aB9:bc800").Select
bango = Application.InputBox("box番号入力して下さい")
Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub box_kensaku_3()
Dim bango As String
Sheets("box").Select
On Error GoTo errorcheck
Range("Bh9:bh800").Select
bango = Application.InputBox("box番号入力して下さい", Default:=Cells(1, 25))
Cells(2, 25) = bango
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
Range(Cells(gyou, retu + 1), Cells(gyou, retu + 1)).Select
res = MsgBox("集計しますか", vbYesNo)
If res = vbYes Then
Cells(gyou, retu + 1) = Cells(gyou, retu + 1) + 1
End If
Call boxsort
Range("B3:W64").Select
Exit Sub
errorcheck:
MsgBox ("番号がありません。チェックして下さい"): End
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 回号連動()
Dim ban_go As long
ban_go = Application.InputBox("番号入力して下さい", 1)
If ban_go > 9 And ban_go < 0 Then End
For i = 2 To 716
For n = 1 To 4
If ban_go = Cells(i, n + 2) Then
Cells(i, 1) = Cells(i, 1) & "*"
Exit For
End If
Next n
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 三桁連動()
Dim sanban_go As String
sanban_go = Application.InputBox("三桁BOX番号入力して下さい", 1)
' If ban_go > 9 And ban_go < 0 Then End
For i = 2 To 716
For n = 1 To 4
If ban_go = Cells(i, n + 2) Then
Cells(i, 1) = Cells(i, 1) & "*"
Exit For
End If
Next n
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 欠け算差抽出()
Dim kban_go As long
kban_go = Application.InputBox("欠け算差番号入力して下さい", 1)
If kban_go >= 6 Then End
For i = 2 To 716
For n = 1 To 4
If kban_go = Cells(i, n + 33) Then
Cells(i, 38) = Cells(i, 38) & kban_go
End If
Next n
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub kakezan_kensaku()
Dim bango As String
Sheets("boxかけ算").Select
Range("B2:W715").Select
bango = Application.InputBox("かけ算番号入力して下さい")
For i = 1 To 715
For j = 1 To 10
If Cells(i + 1, j + 11) = bango Then
Cells(i + 1, 1) = bango
End If
Next j
Next i
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
ナンバーズ4 の かけ算展開(2桁)
Sub kake2ketanlis()
saikeisanoff
i = 154
Do Until Cells(3, i) = ""
boxbango = Cells(3, i)
Range("Z4:Z718").Select '検索する
Selection.Find(What:=boxbango, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
gyou = ActiveCell.Row
Range(Cells(gyou, 27), Cells(gyou, 44)).Copy
Cells(4, i).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
If i > 5000 Then Exit Do
i = i + 1
Loop
saikeisanon
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub kake2ketanlis_1()
saikeisanoff
Dim retu As long
Dim boxbango As String
i = 154
retu = ActiveCell.Column
Cells(3, retu) = Cells(1, 1)
boxbango = Cells(3, retu)
If boxbango = "" Then End
Range("Z4:Z718").Select '検索する
Selection.Find(What:=boxbango, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
gyou = ActiveCell.Row
Range(Cells(gyou, 27), Cells(gyou, 44)).Copy
Cells(4, retu).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
saikeisanon
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub red_maru() '赤丸にする。
With Selection.Font
.Color = 255
End With
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 入力◎●()’当選番号のシングルとそれ以外を記入する
Dim t As long
Sheets("box飛").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
bango = Application.InputBox("番号入力して下さい●=1､◎=2", Default:=1)
If bango = 1 Then
Cells(gyou, retu) = "●"
ElseIf bango = 2 Then
Cells(gyou, retu) = "◎"
Else
End
End If
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub filter()
For ff = 1 To 25
Selection.AutoFilter Field:=ff
Next ff
z = 1
Do Until Cells(1 + z, 1) = ""
z = z + 1
Loop
Range("a２").Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub saikeisanon()’再計算をする
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
Sub saikeisanoff()’再計算を止める
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub tatecopi() '横に並んだデータを縦に並べる （当たる博士のデータを）
gyou = ActiveCell.Row
retu = ActiveCell.Column
Dim kouhosuu(600) As String
i = 0: y = 0: z = 0
Do Until Cells(gyou, retu + i) = ""
k = 0
Do Until Cells(gyou + k, retu + i) = ""
y = y + 1: z = y
kouhosuu(y) = Cells(gyou + k, retu + i)
Range(Cells(gyou + k, retu + i), Cells(gyou + k, retu + i)).Select
Selection.ClearContents
If k > 280 Then Exit Do
k = k + 1
Loop
If i > 501 Then Exit Do
i = i + 1
Loop
For y = 1 To z
Range(Cells(gyou + y, retu), Cells(gyou + y, retu)).Select
Selection.NumberFormatLocal = "@"
Cells(gyou + y, retu) = kouhosuu(y)
Next y
Range("av1") = z
Range(Cells(gyou, retu), Cells(gyou, retu)).Sort Key1:=Range(Cells(gyou, retu), Cells(gyou + k, retu + i)), Order1:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Cells(gyou + 1, retu).Select
End Sub
-----------------------------------------------
Sub 消す()
Sheets("boxかけ算").Select
Range("A2:A716").Select
Selection.ClearContents
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 間隔コピー()
ChDir "C:\Users\km\Desktop\NUMBERS 関 連"
Workbooks.Open Filename:="C:\Users\km\Desktop\NUMBERS 関 連\n4プロパティ分析.xlsm"
Windows("n4プロパティ分析.xlsm").Activate
Sheets("千百分析").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("B3").Select
ActiveSheet.Paste
Windows("n4プロパティ分析.xlsm").Activate
Sheets("千十分析").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("cz3").Select
ActiveSheet.Paste
Windows("n4プロパティ分析.xlsm").Activate
Sheets("千一分析 ").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("gx3").Select
ActiveSheet.Paste
Windows("n4プロパティ分析.xlsm").Activate
Sheets("百十分析").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("kv3").Select
ActiveSheet.Paste
Windows("n4プロパティ分析.xlsm").Activate
Sheets("百一分析 ").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("ot3").Select
ActiveSheet.Paste
Windows("n4プロパティ分析.xlsm").Activate
Sheets("十一分析 ").Select
Range("K1:DF70").Select
Selection.Copy
Windows("No.4予測ﾊﾟﾀｰﾝ抽出.xlsm").Activate
Sheets("間隔").Select
Range("sr3").Select
ActiveSheet.Paste
Columns("B:wm").Select
Selection.ColumnWidth = 4.63
End Sub
----------------------------------------------------------------------------------
Sub nmbers4() 'クイックピック用マクロ
saikeisanoff
Sheets("QP").Select
Randomize
Range("a1:b10").Select
Selection.ClearContents
count_5 = 0
For i = 1 To 4
kai = Int(Rnd() * 10)
Cells(i, 1) = kai
Range("c1") = "=count(a1:a10)"
Next i
Range("A1:A4").Select
Selection.Copy
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
saikeisanon
End Sub