趣味のエクセルマクロ

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

マクロ関数

エクセルには用意された関数がありますね。


それとは別に自分でマクロ関数を作ることが出来ます。(ユーザー定義関数)
作ったマクロ関数はセルに入れることで複雑な処理が可能になります。
Functionから始まりEnd Functionで終わるマクロを作成します。



ナンバーズ4において、奇数偶数や大小のパターン分類に使っています。


セルZ4771に上の様にマクロ関数を入れます。(V4771,W4771、X4771、Y4771)


マクロ関数では、arg_BNum1 がV4771、 arg_BNum2 がW4771、arg_BNum3 がX4771
arg_BNum4 がY4771に対応します。 Zセル下にコピーすることにより連続して結果が
出て来ます。(V4772,W4772,X4772,Y4772から計算される)



'奇偶パターン判定マクロ関数
 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’Z4771のセルにパターンを出す。
 
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


----------------------------------------------------------------------------------------------


下記のマクロ関数はプロが作ったロト6のものですが、私は自分で分かる範囲だけを
少しパクってましたw

(デジタルナンバーズクラブのエクセルでのロト6予測ソフトから抜粋)


・引っ張りは 前回と同じ番号が出た時の個数
・復活は 前々回の番号が前回出ないで今回出た時の個数
・続きは 隣あった番号の個数
・飛びは 隣同志の間隔が1の場合の時の個数
       ボーナス番号は除外されてるようです。


Option Explicit


Public Const F_HIGH = 1
Public Const F_LOW = 2


Public Const F_SIDE1 = 1
Public Const F_SIDE2 = 2


Public Const F_HEIGHT1 = 1
Public Const F_HEIGHT2 = 2



Public Function set_LT6_SIDE_COUNT(arg_sFlag As Integer, arg_num1 As String, arg_num2 As String, arg_num3 As String, arg_num4 As String, arg_num5 As String, arg_num6 As String) As String
  Dim ii, jj, i_hitflg
  Dim wk_colLow As Integer
  Dim wk_colHigh As Integer
  Dim cnt_1P As Integer
  Dim cnt_2P As Integer
 
  If Trim(arg_num1) = "" Or _
     Trim(arg_num2) = "" Or _
     Trim(arg_num3) = "" Or _
     Trim(arg_num4) = "" Or _
     Trim(arg_num5) = "" Or _
     Trim(arg_num6) = "" Then
    set_LT6_SIDE_COUNT = ""
    Exit Function
  End If
 
  cnt_1P = 0
  cnt_2P = 0
  For ii = 1 To 5
    Select Case ii
      Case 1: wk_colLow = CInt(arg_num1)
              wk_colHigh = CInt(arg_num2)
      Case 2: wk_colLow = CInt(arg_num2)
              wk_colHigh = CInt(arg_num3)
      Case 3: wk_colLow = CInt(arg_num3)
              wk_colHigh = CInt(arg_num4)
      Case 4: wk_colLow = CInt(arg_num4)
              wk_colHigh = CInt(arg_num5)
      Case 5: wk_colLow = CInt(arg_num5)
              wk_colHigh = CInt(arg_num6)
    End Select
    If wk_colHigh - wk_colLow = 1 Then cnt_1P = cnt_1P + 1
    If wk_colHigh - wk_colLow = 2 Then cnt_2P = cnt_2P + 1
  Next ii
 
  If arg_sFlag = F_SIDE1 Then set_LT6_SIDE_COUNT = cnt_1P
  If arg_sFlag = F_SIDE2 Then set_LT6_SIDE_COUNT = cnt_2P
 
End Function



Public Function set_LT6_HEIGHT_COUNT(arg_BNum1 As String, _
                                  arg_BNum2 As String, _
                                  arg_BNum3 As String, _
                                  arg_BNum4 As String, _
                                  arg_BNum5 As String, _
                                  arg_BNum6 As String, _
                                  arg_ANum1 As String, _
                                  arg_ANum2 As String, _
                                  arg_ANum3 As String, _
                                  arg_ANum4 As String, _
                                  arg_ANum5 As String, _
                                  arg_ANum6 As String) As String
  Dim ii, jj, i_hitflg
  Dim wk_string As String
  Dim wk_rowCnt As Integer
  Dim wk_numTbl(1 To 43) As Integer
 
  If Trim(arg_ANum1) = "" Or _
     Trim(arg_ANum2) = "" Or _
     Trim(arg_ANum3) = "" Or _
     Trim(arg_ANum4) = "" Or _
     Trim(arg_ANum5) = "" Or _
     Trim(arg_ANum6) = "" Then
    set_LT6_HEIGHT_COUNT = ""
    Exit Function
  End If
 
  For ii = 1 To 43
    wk_numTbl(ii) = 0
  Next ii
 
  For ii = 1 To 6
    Select Case ii
      Case 1: wk_string = arg_BNum1
      Case 2: wk_string = arg_BNum2
      Case 3: wk_string = arg_BNum3
      Case 4: wk_string = arg_BNum4
      Case 5: wk_string = arg_BNum5
      Case 6: wk_string = arg_BNum6
    End Select
    wk_numTbl(CInt(wk_string)) = wk_numTbl(CInt(wk_string)) + 1
  Next ii
 
  wk_rowCnt = 0
  For ii = 1 To 6
    Select Case ii
      Case 1: wk_string = arg_ANum1
      Case 2: wk_string = arg_ANum2
      Case 3: wk_string = arg_ANum3
      Case 4: wk_string = arg_ANum4
      Case 5: wk_string = arg_ANum5
      Case 6: wk_string = arg_ANum6
    End Select
    If wk_numTbl(CInt(wk_string)) > 0 Then wk_rowCnt = wk_rowCnt + 1
  Next ii
 
 
  set_LT6_HEIGHT_COUNT = wk_rowCnt
 
End Function



Public Function set_LT6_FUKATSU_COUNT(arg_B1Num1 As String, _
                                      arg_B1Num2 As String, _
                                      arg_B1Num3 As String, _
                                      arg_B1Num4 As String, _
                                      arg_B1Num5 As String, _
                                      arg_B1Num6 As String, _
                                      arg_B2Num1 As String, _
                                      arg_B2Num2 As String, _
                                      arg_B2Num3 As String, _
                                      arg_B2Num4 As String, _
                                      arg_B2Num5 As String, _
                                      arg_B2Num6 As String, _
                                      arg_ANum1 As String, _
                                      arg_ANum2 As String, _
                                      arg_ANum3 As String, _
                                      arg_ANum4 As String, _
                                      arg_ANum5 As String, _
                                      arg_ANum6 As String) As String
  Dim ii, jj, i_hitflg
  Dim wk_string As String
  Dim wk_rowCnt As Integer
  Dim wk_numTbl(1 To 43) As Integer
 
  If Trim(arg_ANum1) = "" Or _
     Trim(arg_ANum2) = "" Or _
     Trim(arg_ANum3) = "" Or _
     Trim(arg_ANum4) = "" Or _
     Trim(arg_ANum5) = "" Or _
     Trim(arg_ANum6) = "" Then
    set_LT6_FUKATSU_COUNT = ""
    Exit Function
  End If
 
  For ii = 1 To 43
    wk_numTbl(ii) = 0
  Next ii
 
  '復活の計上
  For ii = 1 To 6
    Select Case ii
      Case 1: wk_string = arg_B1Num1
      Case 2: wk_string = arg_B1Num2
      Case 3: wk_string = arg_B1Num3
      Case 4: wk_string = arg_B1Num4
      Case 5: wk_string = arg_B1Num5
      Case 6: wk_string = arg_B1Num6
    End Select
    wk_numTbl(CInt(wk_string)) = wk_numTbl(CInt(wk_string)) + 2
  Next ii
 
  '引っ張りの計上
  For ii = 1 To 6
    Select Case ii
      Case 1: wk_string = arg_B2Num1
      Case 2: wk_string = arg_B2Num2
      Case 3: wk_string = arg_B2Num3
      Case 4: wk_string = arg_B2Num4
      Case 5: wk_string = arg_B2Num5
      Case 6: wk_string = arg_B2Num6
    End Select
    wk_numTbl(CInt(wk_string)) = wk_numTbl(CInt(wk_string)) + 1
  Next ii
 
  wk_rowCnt = 0
  For ii = 1 To 6
    Select Case ii
      Case 1: wk_string = arg_ANum1
      Case 2: wk_string = arg_ANum2
      Case 3: wk_string = arg_ANum3
      Case 4: wk_string = arg_ANum4
      Case 5: wk_string = arg_ANum5
      Case 6: wk_string = arg_ANum6
    End Select
    If wk_numTbl(CInt(wk_string)) = 2 Then wk_rowCnt = wk_rowCnt + 1
  Next ii
 
 
  set_LT6_FUKATSU_COUNT = wk_rowCnt
 
End Function