趣味のエクセルマクロ

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

3.N4プロパティ分析


Sub 二桁毎の各種分析()
'マクロ記録で作成
    Range("B3:X104").Select
Selection.Copy
Range("B150").Select
ActiveSheet.Paste
Range("B260").Select
ActiveSheet.Paste
Range("B152:D251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("C152:C251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("B152:D251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F152:H251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("G152:G251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("F152:H251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("J152:L251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("K152:K251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("J152:L251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
  Range("N152:P251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("O152:O251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("N152:P251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
    Range("R152:T251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("S152:S251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("R152:T251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With  
Range("V152:X251").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("W152:W251") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("V152:X251")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=25
Range("B262:D361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("D262:D361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("B262:D361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-82
Range("F262:H361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("H262:H361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("F262:H361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-79
Range("J262:L361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("L262:L361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("J262:L361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-80
Range("N262:P361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("P262:P361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("N262:P361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.LargeScroll Down:=-3
Range("R262:T361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("T262:T361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("R262:T361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.LargeScroll Down:=-3
Range("V262:X361").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("X262:X361") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("V262:X361")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
  Range("B152").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub そ_と千一() ’千百から十一までの2桁毎の未出間隔並び替え
saikeisanoff
Range("B152:D251").Select
Selection.Copy
Range("Z151").Select
ActiveSheet.Paste
Range("AC151").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1100"
Range("AC151").Select
Selection.AutoFill Destination:=Range("AC151:AC250")
Range("AC151:AC250").Select
Range("F152:H251").Select
Selection.Copy
Range("Z251").Select
ActiveSheet.Paste
Range("AC251").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1010"
Range("AC251").Select
Selection.AutoFill Destination:=Range("AC251:AC350")
Range("AC251:AC350").Select
  Range("J152:L251").Select
Selection.Copy
ActiveWindow.LargeScroll Down:=4
Range("Z351").Select
ActiveSheet.Paste
Range("AC351").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1001"
Range("AC351").Select
Selection.AutoFill Destination:=Range("AC351:AC450")
Range("AC351:AC450").Select
Range("N152:P251").Select
Selection.Copy
Range("Z451").Select
ActiveSheet.Paste
Range("AC451").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "110"
Range("AC451").Select
Selection.AutoFill Destination:=Range("AC451:AC550")
Range("AC451:AC550").Select
Range("R152:T251").Select
Selection.Copy
Range("Z551").Select
ActiveSheet.Paste
Range("AC551").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "101"
Range("AC551").Select
Selection.AutoFill Destination:=Range("AC551:AC650")
Range("AC551:AC650").Select
Range("V152:X251").Select
Selection.Copy
Range("Z651").Select
ActiveSheet.Paste
Range("AC651").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "11"
Range("AC651").Select
Selection.AutoFill Destination:=Range("AC651:AC750")
Range("AC651:AC750").Select
Range("AE651").Select
   Range("Z151:AC750").Select
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("AA151:AA750" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("桁分析").Sort.SortFields.Add Key:=Range("AB151:AB750" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("桁分析").Sort
.SetRange Range("Z151:AC750")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
saikeisanon
Range("Z151").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 非表示()
    Rows("3:11").Select
Selection.EntireRow.Hidden = True
Rows("31:39").Select
Selection.EntireRow.Hidden = True
End Sub
----------------
Sub 表示()
Rows("30:40").Select
Selection.EntireRow.Hidden = False
Rows("2:12").Select
Selection.EntireRow.Hidden = False
End Sub
--------------------------------------------------------------------------------------------------------
Sub 月曜日()
retu = ActiveCell.Column
gyou = ActiveCell.Row
     Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleDouble
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 木曜日()
retu = ActiveCell.Column
gyou = ActiveCell.Row
Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 大小へ()
    ActiveWindow.SmallScroll ToRight:=165
End Sub


Sub 合計へ()
   ActiveWindow.SmallScroll ToRight:=-400
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub Boxx_Kensaku()
On Error GoTo errorcheck
'Static maeban
maeban = Cells(1, 1)
Range("B2:b1430").Select
bango = Application.InputBox("BOX番号入力して下さい", Default:=maeban)
maeban = bango
Cells(1435, 1) = maeban
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), 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 As Integer
      Dim st_no As String
          saikeisanoff
        st_no = Sheets("奇遇").Cells(1, 1)
        Sheets("box").Select
           
           gyou = ActiveCell.Row
           retu = ActiveCell.Column
        
           kai = retu - 3
        
          Start = MsgBox(st_no & "で入力しますか?", vbYesNo)
          If Start = vbNo Then End   
           If Cells(gyou, retu) = "" Then Cells(gyou, retu) = st_no
      
          For r = 3 To k Step 2
            If Cells(gyou, r) = st_no Then
               Cells(gyou, retu).Select
            
              Call color_set
              Exit For
           
            End If
         
          Next r
      
      saikeisanon
             Cells(gyou, retu).Select
   End Sub