上表の様に関数やマクロを使って表示しています。
関数は一部を残して、あとは値コピーするようにしています。
①当選番号の欄は文字対応としておきます。(0から始まる場合があるので)
②①の番号を4つに分解して合計や奇数偶数や大小関係を計算します。
③また②を元にパターン表を作成します。ボックス番号やシングルやダブルなどの判定。
④計算式や条件設定も使っています。マクロ関数も作成して判定(奇数偶数、大小)
Excel VBA文法はわかるのにプログラムが書けない人が読む本/田中徹【100...
Public patann As long
Public patan As long
Dim stcolo As Range
Dim goguucara As Range
Dim tokiguu As long
Dim kiguu(4) As String
Dim hit(5000, 4) As long
変数はマクロの先頭に書きました。変数の書く場所によって使い方も変わります。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub saikeisanoff()
’再計算オフにして処理を早くさせる。(これをしないとマクロが動かないような?w)
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False
End Sub
マクロのスピードアップ
------------------------------------------
Sub saikeisanon()
’再計算オンにさせる。オフのままだと計算式が動かない為
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
Application.ScreenUpdating = True
End Sub
マクロのスピードアップ
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
当選番号から出目パターン、合計、大小、奇遇、ボックス回数、シングルダブル、等を表示させる。(当選番号を文字とし、4つに分解して処理)
Sub patapata_4() '当選数字パターン貼付け(引張表作成)
Dim i As long, j As long, k As long, dbl As long, kaigou As long
Dim daida As String, Db As String
start = MsgBox("開始しますか?", vbYesNo)’マクロボタン押下でメッセージ出す
If start = vbNo Then End ’中止する時
Worksheets("パターン表").Select
kaigou = Cells(1, 26) ’回号を変数に入れる。
Range(Cells(2, 17), Cells(kaigou + 1, 17)).Select
Selection.Copy
Range("BN2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Bo2:Bz4500", "ca2:ca4500").Select ' 出目パターン表示部をクリアする
Selection.ClearContents
Application.ScreenUpdating = False '画面変更をしない。
Call saikeisanoff
Range("BW2").Activate
Erase hit ’配列変数の内容をクリア(取りあえずw)
i = 2
Do Until Cells(i, 18) = "" ’ Cells(i, 18)のデータが無くなる迄下の処理をする。
dai = 0
For j = 1 To 4 ' 4つの出目の配列変数への入力
hit(i - 1, j) = Cells(i, j + 17)
If hit(i - 1, j) >= 5 Then dai = dai + 1 ’出目の大小、5以上の集計
kiguu(j) = Cells(i, j + 21)
If kiguu(j) = "偶" Then kiguu(j) = "▲" Else kiguu(j) = "△"
If j = 4 Then ’4つの出目の奇遇偶数を集計する
Cells(i, 81) = kiguu(1) + kiguu(2) + kiguu(3) + kiguu(4)
End If
Next j
Select Case dai '大小の表示
Case 0: daida = "■■■■" ’4以下4つの時
Case 1: daida = "■■■□" ’4以下3つの時
Case 2: daida = "■■□□" ’4以下2つの時
Case 3: daida = "■□□□" ’4以下1つの時
Case 4: daida = "□□□□" ’4以下0の時
End Select
Cells(i, 79) = daida
i = i + 1 ’ Cells(i, 18) のiの部分が1づつ増えて行く(下の行に向かっていく)
k = i
If i = 4501 Then Exit Do
Loop
witi = 67 ’表示する列のスタート位置----出目0の時は67列目
For i = 1 To k - 2
For j = 1 To 4 '出目パターン作成(4出目分)
If Cells(i + 1, witi + hit(i, j)) = "" Then
Cells(i + 1, witi + hit(i, j)) = "●"
ElseIf Cells(i + 1, witi + hit(i, j)) = "●" Then
Cells(i + 1, witi + hit(i, j)) = "◎" ’ダブルの時◎にする。
dbl = dbl + 1
If dbl = 1 Then Db = "2" Else Db = " d2"
Cells(i + 1, witi + 11) = Db
ElseIf Cells(i + 1, witi + hit(i, j)) = "◎" Then
Cells(i + 1, witi + hit(i, j)) = "☆" ’トリプルの時☆にする。
Cells(i + 1, witi + 11) = 3
ElseIf Cells(i + 1, witi + hit(i, j)) = "☆" Then
Cells(i + 1, witi + hit(i, j)) = "★" ’フォースの時
Cells(i + 1, witi + 11) = 4
End If
Next j
dbl = 0
Next i
Call box 'ボックス回数カウント等 Sub box()を呼び出して実行させる。
Application.ScreenUpdating = True
Call 当選番号表示’サブルーチン(サブプログラム)呼び出す
Call saikeisanon
End Sub
マクロ 制御式
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'当選番号を小さい順に並び替えて、該当番号の累計出現回数を計算
ストレート番号が何回出たかを色別の縦線で表示
Sub box()
Dim moji(5000) As String
Dim i As long, j As long, x As long, rencyan As long, caler As long
Range("ce2:ce5000").Select
Selection.NumberFormatLocal = "@"
Selection.ClearContents
i = 2
Do Until Cells(i, 18) = ""
For k = 1 To 3
For j = 1 To 3
If hit(i - 1, j) > hit(i - 1, j + 1) Then ’出目を小さい順に並びかえする。
daisyou = hit(i - 1, j)
hit(i - 1, j) = hit(i - 1, j + 1)
hit(i - 1, j + 1) = daisyou
End If
Next j
Next k
For j = 1 To 4 ’当選番号をボックス番号にする(小さい順に並べて)
moji(i) = Trim(moji(i)) + Trim(Str(hit(i - 1, j)))
If j = 4 Then 'ボックス累計回数計算
Cells(i, 83) = moji(i) ’ボックス(bkとする)番号表示する
Cells(i, 84) = Application.CountIf(Range(Cells(2, 83), Cells(i, 83)), Cells(i, 83)) ’bk回数
End If
Next j
caler = Application.CountIf(Range(Cells(2, 66), Cells(i, 66)), Cells(i, 66))
Set stcolo = Application.Cells(i, 66)
stcolo.Borders(xlEdgeLeft).ColorIndex = 1
If caler = 2 Then 'ストレート2回目当選番号の左の線を黄色にする
stcolo.Borders(xlEdgeLeft).ColorIndex = 4
ElseIf caler = 3 Then 'ストレート3回目当選番号の左の線を赤色にする
stcolo.Borders(xlEdgeLeft).ColorIndex = 3
ElseIf caler >= 4 Then 'ストレート4回目以上両脇赤色にする
stcolo.Borders(xlEdgeLeft).ColorIndex = 3
stcolo.Borders(xlEdgeRight).ColorIndex = 3
End If
For x = 1 To 10 '連荘数
If Cells(i, 66 + x) <> "" And Cells(i + 1, 66 + x) <> "" Then
rencyan = rencyan + 1
End If
Next x
If rencyan > 0 Then Cells(i + 1, 77) = rencyan
rencyan = 0
If i = 5000 Then Exit Do
i = i + 1
Loop
Range(Cells(i, 80), Cells(i, 80)).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Sub 当選番号表示() 'たとえば6731を6 7 3 1にしたのをコピー
Worksheets("パターン表").Range("GM2:GM5000").Copy
lasty = Cells(1, 26) + 1
Range("bn2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(lasty, 66).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box間隔2k()'上手く動かないのでbox間隔マクロを2回計算している。
box間隔
box間隔
End Sub
--------------------------------------
Sub box間隔() 'box間隔計算
Dim i As long, k As long, gyou As long
Dim boxspan As String
Worksheets("パターン表").Select
gyou = ActiveCell.Row
If Cells(gyou, 84) = 0 Then End
boxspan = Cells(gyou, 83)
Application.ScreenUpdating = False '画面変更をしない。
If Cells(gyou, 84) = 1 Then '始めてなら
Cells(gyou, 115) = gyou - 1
If gyou > 2000 Then '2000回以降に出たら二重線を引く
Cells(gyou, 115).Select
Selection.Font.Underline = xlUnderlineStyleDouble
End If
Exit Sub
End If
i = 1
Do Until boxspan = Cells(gyou - i, 83)
i = i + 1
If i = 3333 Then Exit Do
Loop
Cells(gyou, 115) = i '間隔記入する
Cells(gyou - i, 78).Select
Selection.Copy '前回のパターンをコピーする。
Cells(gyou, 78).Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(gyou - i, 83).Select
Selection.Copy '前回のパターンをコピーする。
Cells(gyou, 83).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(gyou - i, 84).Select
Selection.Copy '前回のパターンをコピーする。
Cells(gyou, 84).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(gyou - i, 103).Select
Selection.Copy '前回のパターンをコピーする。
Cells(gyou, 103).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(gyou - i, 115).Select
Selection.Copy '前回のパターンをコピーする。
Cells(gyou, 115).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range(Cells(gyou - i, 116), Cells(gyou - i, 121)).Select
Selection.Copy '欠け算コピー
Cells(gyou, 116).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Cells(gyou, 116), Cells(gyou, 127)).Select
Selection.Font.Underline = xlUnderlineStyleNone
Range("DL11:EB11").Select '10回出目からINTまで計算式コピーする。
Selection.Copy
Cells(gyou, 116).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Cells(gyou, 116), Cells(gyou, 132)).Select
Selection.Copy
Cells(gyou, 116).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("da11:dj11").Select '計算式コピーする。
Selection.Copy
Cells(gyou, 105).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Cells(gyou, 105), Cells(gyou, 114)).Select
Selection.Copy
Cells(gyou, 105).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("cv11:cy11").Select '全中後連番まで計算式コピーする。
Selection.Copy
Cells(gyou, 100).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(Cells(gyou, 100), Cells(gyou, 102)).Select
Selection.Copy
Cells(gyou, 100).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True '画面変更。
Cells(gyou, 83).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'デジタルナンバーズ考案の強弱順位を手入力後パターン表示
Sub kyoujyaku()
Erase hit
Worksheets("パターン表").Select
start = MsgBox("強弱順位開始しますか?", vbYesNo)
If start = vbNo Then End
Range("Bd2:Bm5000").Select
Selection.ClearContents
Range("ar2:Ba5000").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Call saikeisanoff
Application.ScreenUpdating = False '画面変更をしない。
i = 8
witi = 55
Do Until Cells(i, 18) = ""
For j = 1 To 4
hit(i - 7, j) = Cells(i, j + 17)
For m = 1 To 10
If hit(i - 7, j) = Cells(i - 1, m + 43) Then
If Cells(i, witi + m) = "" Then
Cells(i, witi + m) = "●"
ElseIf Cells(i, witi + m) = "●" Then
Cells(i, witi + m) = "◎"
ElseIf Cells(i, witi + m) = "◎" Then
Cells(i, witi + m) = "☆"
ElseIf Cells(i, witi + m) = "☆" Then
Cells(i, witi + m) = "★"
End If
End If
Next m
Next j
For k = 1 To 10
If Cells(i, 55 + k) <> "" Then
Cells(i, 43 + k).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End If
Next k
If i = 5000 Then Exit Do
i = i + 1
Loop
Application.ScreenUpdating = True '画面変更。
Range(Cells(i, witi), Cells(i, witi)).Select
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
マクロの改造は簡単か?(N4ホットナンバー)
Sub hotnum_color()
Dim maruiti As Range
Dim gyou As long, retu As long, yiti As long
Dim demebar As Object, ndemebar As Object, tdemebar As Object, demerenbar As Object
Worksheets("パターン表").Select
Application.ScreenUpdating = False '画面変更をしない。
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu <= 17 Or retu >= 22 Then End
deme__iti = Cells(gyou, retu) + 67
deme = Cells(gyou, retu) '出目
If Cells(gyou, retu) > 4 Then
With Selection.Interior
.Color = 65535
End With
Else
With Selection.Interior
.Color = 10092543
End With
End If
Set maruiti = Application.Cells(gyou, deme__iti)
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.ColorIndex = 53
yiti = deme - Cells(gyou, 85) '出目の位置
Cells(gyou + yiti, retu + 70).Select '桁別に88行から出目対応して上に
With Selection.Interior
.Color = 10092543
End With
Sheets("欠け算並び").Cells(gyou + 8, retu + 125) = Worksheets("パターン表").Cells(gyou, retu)
Worksheets("パターン表").Select
Application.ScreenUpdating = True '画面変更をしない。
Cells(gyou + 1, retu).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
' =COUNTIF($R$4492:$U$4501,AI4501)を=COUNTIF($R$4502:$U$4511,AI4502)に変換
計算式が10行ごとに変わるので10行ごとに作成(4桁での10行分の出現出目の集計)
Sub 間隔計算式__置換() '計算式置換コピーテストWhat:="4302", Replacement:="4312"
Dim gyou As long, retu As long
Worksheets("パターン表").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu <> 36 And retu <> 88 Then End
a_gyou = gyou - 10
b_gyou = gyou - 1
c_gyou = gyou + 9
Cells(gyou, retu).Select
ActiveCell.Replace What:=a_gyou, Replacement:=gyou, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:=b_gyou, Replacement:=c_gyou, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
-----------------------------------------------------------------------------------
Sub 間隔計算式入力() ’2019年現在は上のマクロから、このマクロを使用しています。
Dim gyou As long, retu As long
Worksheets("パターン表").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu <> 36 And retu <> 88 Then End
Cells(gyou, retu).Select
If retu = 36 Then
If Cells(gyou, retu - 1) = 0 Then
Cells(gyou, retu) = "=COUNTIF($R$" & gyou & ":$U$" & gyou + 9 & ",AI" & gyou & ")"
End If
Selection.Copy
Range(Cells(gyou, retu), Cells(gyou + 9, retu)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(gyou - 2, retu).Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(gyou, retu), Cells(gyou + 9, retu)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ElseIf retu = 88 Then
’セルの列の位置は決まっているので、行の位置だけ変化させる。
If Cells(gyou, retu - 3) = 0 Then
Cells(gyou, retu) = "=COUNTIF($R$" & gyou & ":$R$" & gyou + 9 & ",$AI" & gyou & ")"
Cells(gyou, retu + 1) = "=COUNTIF($S$" & gyou & ":$S$" & gyou + 9 & ",$AI" & gyou & ")"
Cells(gyou, retu + 2) = "=COUNTIF($T$" & gyou & ":$T$" & gyou + 9 & ",$AI" & gyou & ")"
Cells(gyou, retu + 3) = "=COUNTIF($U$" & gyou & ":$U$" & gyou + 9 & ",$AI" & gyou & ")"
Range(Cells(gyou, retu + 4), Cells(gyou, retu + 6)) = 0
Range(Cells(gyou, retu), Cells(gyou, retu + 6)).Select
Selection.Copy
Range(Cells(gyou, retu), Cells(gyou + 9, retu + 6)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub deme4間隔() 'deme間隔でアンダーバー引く(青色部)
Dim i As long, k As long, gyou As long, retu As long
Dim deme As long, ndeme As long, yiti As long
Dim demebar As Range, ndemebar As Range, tdemebar As Range
Dim demerenbar As Range,demebar As Range
Worksheets("パターン表").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If ActiveCell.Column <= 137 And ActiveCell.Column >= 142 Then End
deme = Cells(gyou, retu) '出目
yiti = deme - Cells(gyou, 85) '出目の位置
Set demebar = Application.Cells(gyou, retu)
Set ndemebar = Application.Cells(gyou + yiti, retu + 70) '桁別に88行から出目対応して上下に
Set tdemebar = Application.Cells(gyou, 116 + deme) '10出目毎に
i = 1
Do Until deme = Cells(gyou - i, retu)
i = i + 1
k = i - 1
If i = 2000 Then Exit Do
Loop
If k >= 10 And k <= 29 Then
demebar.Font.Underline = xlUnderlineStyleSingle
ndemebar.Font.Underline = xlUnderlineStyleSingle
tdemebar.Font.Underline = xlUnderlineStyleSingle
ElseIf k >= 30 Then
demebar.Font.Underline = xlUnderlineStyleDouble
ndemebar.Font.Underline = xlUnderlineStyleDouble
tdemebar.Font.Underline = xlUnderlineStyleDouble
Else
demebar.Font.Underline = xlUnderlineStyleNone
ndemebar.Font.Underline = xlUnderlineStyleNone
End If
Cells(gyou + 1, retu).Select
'deme4間隔
' return0
'自動で脇の桁に移動
If Cells(gyou + 1, retu) = "" Then
Cells(gyou, retu + 1).Select
End
End If
End Sub
2019年現在上のマクロの一部改良(シート 欠け算並び への出力)
Sub deme4間隔() 'deme間隔でアンダーバー引く
Dim i As long, k As long, gyou As long, retu As long, deme As long, ndeme, yiti As long
Dim demebar As Range, ndemebar As Range, tdemebar As Range
Dim demerenbar As Range, kdemebar As Range
Worksheets("パターン表").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If ActiveCell.Column <= 137 And ActiveCell.Column >= 142 Then End
deme = Cells(gyou, retu) '出目
yiti = deme - Cells(gyou, 85) '出目の位置
Set demebar = Application.Cells(gyou, retu)
Set ndemebar = Application.Cells(gyou + yiti, retu + 70) '桁別に88行から出目対応して上下に
Set tdemebar = Application.Cells(gyou, 116 + deme) '10出目毎に
Set kdemebar = Application.Worksheets("欠け算並び").Cells(gyou + 8, retu + 132)
i = 1
Do Until deme = Cells(gyou - i, retu)
i = i + 1
k = i
If i = 2000 Then Exit Do
Loop
If k >= 10 And k <= 29 Then
demebar.Font.Underline = xlUnderlineStyleSingle
ndemebar.Font.Underline = xlUnderlineStyleSingle
tdemebar.Font.Underline = xlUnderlineStyleSingle
kdemebar.Font.Underline = xlUnderlineStyleSingle
ElseIf k >= 30 Then
demebar.Font.Underline = xlUnderlineStyleDouble
ndemebar.Font.Underline = xlUnderlineStyleDouble
tdemebar.Font.Underline = xlUnderlineStyleDouble
kdemebar.Font.Underline = xlUnderlineStyleDouble
Else
demebar.Font.Underline = xlUnderlineStyleNone
ndemebar.Font.Underline = xlUnderlineStyleNone
kdemebar.Font.Underline = xlUnderlineStyleNone
End If
Worksheets("欠け算並び").Select
If k = 0 Then
Cells(gyou + 8, retu + 132) = 0
Else
Cells(gyou + 8, retu + 132) = k - 1
End If
Worksheets("パターン表").Select
Cells(gyou + 1, retu).Select
'deme4間隔
' return0
'自動で脇の桁に移動
If Cells(gyou + 1, retu) = "" Then
Cells(gyou, retu + 1).Select
End
End If
End Sub
********************************************************************
Sub iroNuri()
gyou = ActiveCell.Row
retu = ActiveCell.Column
Cells(gyou, retu).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092543
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub 入力へ()
actsheet = ActiveSheet.Name
If actsheet = "パターン表" Then '
jp = Cells(1, 26) + 2
Cells(jp, 17).Select
ElseIf actsheet = "欠け算並び" Then '
jp = Cells(1, 2) + 8
Cells(jp, 2).Select
End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
マクロ関数を作成します。(自由に関数が作成することが出来る様になってる)
'奇偶判別 マクロ関数 arg_BNum1が v4344にーー arg_BNum4 がY4344に対応
(マクロで関数を(奇偶並びで16パターン判別用)作成)
マクロ関数
Function set_NUFkiguu(arg_BNum1 As String, _
arg_BNum2 As String, _
arg_BNum3 As String, _
arg_BNum4 As String) As Integer
Dim kigu As Integer
If arg_BNum1 = "奇" And arg_BNum2 = "奇" Then
If arg_BNum3 = "奇" And arg_BNum4 = "奇" Then kigu = 1
If arg_BNum3 = "奇" And arg_BNum4 = "偶" Then kigu = 3
If arg_BNum3 = "偶" And arg_BNum4 = "奇" Then kigu = 4
If arg_BNum3 = "偶" And arg_BNum4 = "偶" Then kigu = 11
End If
If arg_BNum1 = "偶" And arg_BNum2 = "偶" Then
If arg_BNum3 = "偶" And arg_BNum4 = "偶" Then kigu = 2
If arg_BNum3 = "偶" And arg_BNum4 = "奇" Then kigu = 7
If arg_BNum3 = "奇" And arg_BNum4 = "偶" Then kigu = 8
If arg_BNum3 = "奇" And arg_BNum4 = "奇" Then kigu = 14
End If
If arg_BNum1 = "奇" And arg_BNum2 = "偶" Then
If arg_BNum3 = "奇" And arg_BNum4 = "奇" Then kigu = 5
If arg_BNum3 = "奇" And arg_BNum4 = "偶" Then kigu = 12
If arg_BNum3 = "偶" And arg_BNum4 = "奇" Then kigu = 13
If arg_BNum3 = "偶" And arg_BNum4 = "偶" Then kigu = 10
End If
If arg_BNum1 = "偶" And arg_BNum2 = "奇" Then
If arg_BNum3 = "偶" And arg_BNum4 = "偶" Then kigu = 9
If arg_BNum3 = "偶" And arg_BNum4 = "奇" Then kigu = 15
If arg_BNum3 = "奇" And arg_BNum4 = "偶" Then kigu = 16
If arg_BNum3 = "奇" And arg_BNum4 = "奇" Then kigu = 6
End If
set_NUFkiguu = kigu
End Function
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'大小判別 マクロ関数
Function set_NUFdaisyo(arg_BNum As String) As Integer
Dim daisyo As Integer
daisyo = 0
If arg_BNum = "□□□□" Then daisyo = 1
If arg_BNum = "■■■■" Then daisyo = 2
If arg_BNum = "□□□■" Then daisyo = 3
If arg_BNum = "□□■□" Then daisyo = 4
If arg_BNum = "□■□□" Then daisyo = 5
If arg_BNum = "■□□□" Then daisyo = 6
If arg_BNum = "■■■□" Then daisyo = 7
If arg_BNum = "■■□■" Then daisyo = 8
If arg_BNum = "■□■■" Then daisyo = 9
If arg_BNum = "□■■■" Then daisyo = 10
If arg_BNum = "□□■■" Then daisyo = 11
If arg_BNum = "□■□■" Then daisyo = 12
If arg_BNum = "□■■□" Then daisyo = 13
If arg_BNum = "■■□□" Then daisyo = 14
If arg_BNum = "■□■□" Then daisyo = 15
If arg_BNum = "■□□■" Then daisyo = 16
set_NUFdaisyo = daisyo
End Function
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー