趣味のエクセルマクロ

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

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, gyou, retu, Start, kai, k As Integer
      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, akamarukazu As Integer
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 Integer
Dim keta_2(10000, 6) As Integer
saikeisanoff
 Windows("no4各種分析.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 Integer
 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 Integer
 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
---------------------------------

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 Integer
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 Integer
 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("a2").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