趣味のエクセルマクロ

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

2.LOTO6

Sub c_and_s() '第一数字から小さい順にソート、(自動マクロ記録で作成)
kaigo = Sheets("元データ").Cells(1, 38)
 Sheets("表 (2)").Select
  Range(Cells(2, 1), Cells(2 + kaigo, 9)).Select
  Selection.Copy
  Sheets("リスト1").Select
  Range("A2").Select
  ActiveSheet.Paste
  Range("C10").Select
  Sheets("元データ").Select
  Range(Cells(2, 12), Cells(2 + kaigo, 12)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("リスト1").Select
  Range("J2").Select
  ActiveSheet.Paste
   Range(Cells(2, 1), Cells(2 + kaigo, 10)).Select
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2 + kaigo, 2)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(2 + kaigo, 3)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(2 + kaigo, 4)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(2 + kaigo, 5)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(2 + kaigo, 6)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(2 + kaigo, 7)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      ActiveWorkbook.Worksheets("リスト1").Sort.SortFields.Add Key:=Range(Cells(2, 8), Cells(2 + kaigo, 8)) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("リスト1").Sort
      .SetRange Range(Cells(2, 1), Cells(2 + kaigo, 10))
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With 
End Sub
-----------------------------------------------------------------------------------------------------

Sub c_and_s2() ’パターン表もソートする
  kaigo = Sheets("元データ").Cells(1, 38)
  Sheets("分析 (2)").Select
Range(Cells(2, 1), Cells(2 + kaigo, 59)).Select
  Selection.Copy
  Sheets("リスト2").Select
   Range("A2").Select
  ActiveSheet.Paste 
    Range(Cells(2, 1), Cells(2 + kaigo, 59)).Select
  Application.CutCopyMode = False
  ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2 + kaigo, 2)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(2 + kaigo, 3)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(2 + kaigo, 4)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
   ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(2 + kaigo, 5)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(2 + kaigo, 6)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(2 + kaigo, 7)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal     
    ActiveWorkbook.Worksheets("リスト2").Sort.SortFields.Add Key:=Range(Cells(2, 8), Cells(2 + kaigo, 8)), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("リスト2").Sort
      .SetRange Range(Cells(2, 1), Cells(2 + kaigo, 59))
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
    Range(Cells(2, 10), Cells(2 + kaigo, 52)).Select
   Selection.Font.Underline = xlUnderlineStyleSingle
   Selection.Font.Underline = xlUnderlineStyleNone
  With Selection.Font
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
  End With
  Range("A1").Select
End Sub
-----------------------------------------------------------------------------------------------------
Sub 表へ() ’シートから別のシート(表へ)に移動する。
 Sheets("表").Select
End Sub


Sub 分析2へ()
 Sheets("分析 (2)").Select
End Sub


Sub 表2へ()
 Sheets("表 (2)").Select
End Sub


Sub 元データへ()
 Sheets("元データ").Select
End Sub


Sub リスト1へ()
 Sheets("リスト1").Select
End Sub
-----------------------------------------------------------------------------------------------------

'星座にナンバリングするマクロ関数
Function set_NUFseiza(arg_seizaNum As String) As Integer
Dim seiza As Integer
seiza = 0
  If arg_seizaNum = "牡羊座" Then seiza = 1
  If arg_seizaNum = "牡牛座" Then seiza = 2
  If arg_seizaNum = "双子座" Then seiza = 3
  If arg_seizaNum = "蟹座" Then seiza = 4
  If arg_seizaNum = "獅子座" Then seiza = 5
  If arg_seizaNum = "乙女座" Then seiza = 6
  If arg_seizaNum = "天秤座" Then seiza = 7
  If arg_seizaNum = "蠍座" Then seiza = 8
  If arg_seizaNum = "射手座" Then seiza = 9
  If arg_seizaNum = "山羊座" Then seiza = 10
  If arg_seizaNum = "水瓶座" Then seiza = 11
  If arg_seizaNum = "魚座" Then seiza = 12                 
  set_NUFseiza = seiza'星座を1から12にセルに表示する
End Function
-------------------------------------------------------------------------------------------------------


Sub Seiza_total() '星座毎に集計 
Dim kai, i, y, x, h As Integer
Sheets("元データ").Select
Range("DF4:DQ46").Select
   Selection.ClearContents
Range("DF50:DQ50").Select
   Selection.ClearContents  
kai = Cells(1, 38) - 1
saikeisanoff
For h = 0 To kai
For i = 1 To 7
  y = Cells(2 + h, i + 3) '1番目~7番目の出目
  x = Cells(2 + h, 20) + 109 '星座タイプ番号
  Cells(y + 3, x) = Cells(y + 3, x) + 1 '集計して出力
Next i
    Cells(50, x) = Cells(50, x) + 1 '星座集計して出力
Next h
    Range("DB1").Select
 saikeisanon
End Sub
-------------------------------------------------------------------------------------------------------


Sub tajyuucopy() '多重当選の計算する。


 Sheets("分析 (2)").Select
 Range("BJ2:CZ1500").Select
    Selection.ClearContents
  
       saikeisanoff


 For n = 1 To 43
  
i = 1
  Do Until Cells(i + 1, 5) = ""
     
     If Cells(i + 1, 9 + n) <> "" Then
          Cells(i + 1, 61 + n) = 1
     End If
  
    If i = 1500 Then Exit Do'1500回まではマクロ実行可能 それ以外はエラーになる
     i = i + 1
  Loop


 Next n


 For m = 1 To 43


i = 1
  Do Until Cells(i + 1, 5) = ""
   
     If Cells(i + 1, 61 + m) >= 1 Then '多重カウントする。
               If Cells(i + 2, 61 + m) = 1 Then
              Cells(i + 2, 61 + m) = Cells(i + 1, 61 + m) + 1
              Cells(i + 1, 61 + m) = ""
              End If
     End If
  
    If i = 1500 Then Exit Do
     i = i + 1
  
  Loop


 Next m


Cells(i, 2).Select
   
  saikeisanon
  
End Sub
---------------------------------------------------------------------------
Sub tajyupatacopy()
 ' 多重集計用コピーをする
Dim gyou As Integer
 gyou = ActiveCell.Row
     Range(Cells(gyou, 10), Cells(gyou, 52)).Select


  Selection.Copy
   Sheets("分析 (2)").Select
 Range(Cells(gyou + 1, 62), Cells(gyou + 1, 62)).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Application.CutCopyMode = False
   Cells(gyou, 1).Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub 挿入準備() 'データ挿入行の準備
gyou = ActiveCell.Row
     Sheets("リスト1").Select
   Rows(gyou).Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Sheets("リスト2").Select
   Rows(gyou).Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Sheets("リスト1").Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub mi_toutalgo()
 i = 1
 Do Until Cells(i, 53) = ""
   If i = 1000 Then Exit Do
    i = i + 1
 Loop
 Cells(i, 53).Select
 End Sub
 -----------------------------------------------------------------------------------------------------
 Sub first_検索()
Dim gyou, nunban, nextbango As Integer
 Range("c2:c1000").Select
 bango = Application.InputBox("最初の番号は何番ですか ")
   Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, MatchByte:=False, SearchFormat:=False).Activate
 gyou = ActiveCell.Row


 caunter = Application.CountIf(Range(Cells(gyou, 3), Cells(gyou + 100, 3)), bango) - 1


 nextbango = Application.InputBox("二番目の番号は何番ですか ")
If bango >= nextbango Then MsgBox "データ等をチェックして下さい。": End
     Range(Cells(gyou + 1, 62), Cells(gyou + 1, 62)).Select
   Selection.Find(What:=nextbango, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , MatchByte:=False, SearchFormat:=False).Activate
 End Sub
-----------------------------------------------------------------------------------------------------