趣味のエクセルで当てよう!ロト・ナンバーズ

当選狙いで、ナンバーズ4をメインにロト、ビンゴ5などの各種データリストや、それらの分析用エクセルVBAなどについて書いてます。

1.ナンバーズ4パターン表作成関係エクセルマクロ(1)


記事目次 ナンバーズ4 


上表の様に関数やマクロを使って表示しています。
関数は一部を残して、あとは値コピーするようにしています。


①当選番号の欄は文字対応としておきます。(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


変数はマクロの先頭に書きました。変数の書く場所によって使い方も変わります。


マクロ学習法とは 10(続・変数) 


変数 知らなかった本当の使い方 



ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー


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
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー


記事目次 ナンバーズ4