ムラゴン ホーム
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("リスト１").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("リスト１").Select
Range("J2").Select
ActiveSheet.Paste
Range(Cells(2, 1), Cells(2 + kaigo, 10)).Select
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2 + kaigo, 2)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 3), Cells(2 + kaigo, 3)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(2 + kaigo, 4)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 5), Cells(2 + kaigo, 5)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(2 + kaigo, 6)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 7), Cells(2 + kaigo, 7)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("リスト１").Sort.SortFields.Add Key:=Range(Cells(2, 8), Cells(2 + kaigo, 8)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("リスト１").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("リスト１").Select
End Sub
-----------------------------------------------------------------------------------------------------
'星座にナンバリングするマクロ関数 fxに計算式表示される
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'星座を１から12にセルに表示する
End Function
-------------------------------------------------------------------------------------------------------
変数 知らなかった本当の使い方
Sub Seiza_total() '星座毎に集計
Dim kai As long, i As long, y As long, x As long, h As long
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 long
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("リスト１").Select
Rows(gyou).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("リスト2").Select
Rows(gyou).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("リスト１").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
-----------------------------------------------------------------------------------------------------