常連

【頁No.2】
```VBA
'***********************************************
' 初期値取得
'***********************************************
Function 初期値取得() As Boolean
    '(処理済みSkip)
    If mblnMaster = True Then Exit Function
    '(取得WorkRange)
    Set rng商品域 = Range(str商品域)
    Set rng予算域 = Range(str予算域)
    Set rng結果域 = Range(str結果域)
    '(取得Masterデータ商品)
    mintArCnt = 0
    For Each mMyRange In Range(str商品域)
        ReDim Preserve M商品(mintArCnt)
        M商品(mintArCnt).strM名称 = Cells(mMyRange.Row, mMyRange.Column + 0)
        M商品(mintArCnt).dblM金額 = CDec(Cells(mMyRange.Row, mMyRange.Column + 1))
        M商品(mintArCnt).intM優先 = Cells(mMyRange.Row, mMyRange.Column + 2)
        M商品(mintArCnt).intM期限 = 0
        M商品(mintArCnt).lngM行番 = mMyRange.Row
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 0
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
        mintArCnt = mintArCnt + 1
    Next
    For Each mMyRange In Range(str期限商品域)
        For mintArCnt = 0 To UBound(M商品)
            If M商品(mintArCnt).strM名称 = mMyRange Then
                M商品(mintArCnt).intM期限 = Cells(mMyRange.Row, mMyRange.Column + 1)
                Exit For
            End If
        Next
        If M商品(mintArCnt).intM期限 = 0 Then M商品(mintArCnt).intM期限 = 9999
    Next
    '(取得Masterデータ予算)
    mintCount = 0
    mintArCnt = 0
    For Each mMyRange In Range(str予算域)
        ReDim Preserve M予算(mintArCnt)
        mintCount = mintCount + 1
        M予算(mintArCnt).int日目値 = mintCount
        M予算(mintArCnt).lng列位置 = mMyRange.Column
        mintArCnt = mintArCnt + 1
    Next
    '(取得Masterデータ誤差)
    M誤差.dblMst誤差小 = CDec(Range(str誤差小))
    M誤差.dblMst誤差大 = CDec(Range(str誤差大))
    M誤差.dbl合計金額 = 0
    M誤差.dbl予算金額 = 0
    M誤差.dbl下限金額 = 0
    M誤差.dbl上限金額 = 0
    '(初期値取得完了)
    mblnMaster = True
End Function

'***********************************************
' 処理開始
'***********************************************
Function 処理開始(ByVal Target As Range) As Boolean

    Call 初期値取得
    Call 処理_結果値情報取得(Target)
    Call 処理_合計金額パターン抽出(Target)
    If UBound(RData) = 0 Then
        MsgBox "該当金額なし"
        Exit Function
    End If
    Call 処理_最優先レコード選択
    Call 処理_結果書込み(Target)

End Function

'***********************************************
' 処理_結果値情報取得
'***********************************************
Function 処理_結果値情報取得(ByVal Target As Range) As Boolean
    Dim iWork As Integer
    Dim iCnt As Integer
    Dim i日目 As Integer
    Dim i期限日目 As Integer
    Dim MyStr As String
    '初期化
    For mintArCnt = 0 To UBound(M商品)
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 9
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
    Next
    'Target日目
    For mintArCnt = 0 To UBound(M予算)
        If M予算(mintArCnt).lng列位置 = Target.Column Then
            i日目 = M予算(mintArCnt).int日目値
            Exit For
        End If
    Next
    '取得処理
    mlRow1 = rng結果域.Row
    mlRow2 = mlRow1 + rng結果域.Rows.Count - 1
    mlCol1 = rng商品域.Column
    mlCol2 = Target.Column - 1
    mvarResData = Range(Cells(mlRow1, mlCol1), Cells(mlRow2, mlCol2)).Value
    For mintArCnt = 1 To UBound(mvarResData)
        iWork = mintArCnt - 1
        If mvarResData(mintArCnt, 1) = M商品(iWork).strM名称 Then
            iCnt = 0
            i期限日目 = 0
            For mintCount = UBound(mvarResData, 2) To 4 Step -1
                If mvarResData(mintArCnt, mintCount) = "○" Then
                    M商品(iWork).int計上件数 = M商品(iWork).int計上件数 + 1
                    If i期限日目 = 0 Then
                        i期限日目 = (M商品(iWork).intM期限 + M予算(mintCount - 4).int日目値)
                        M商品(iWork).int期限日数 = i期限日目
                        If i期限日目 <= i日目 Then
                            M商品(iWork).int期限区分 = 1
                        End If
                    End If
                End If
            Next
        End If
    Next
    '順位作成
    lSortX = -1
    For mintArCnt = 0 To UBound(M商品)
        MyStr = ""
        MyStr = MyStr & M商品(mintArCnt).int期限区分
        MyStr = MyStr & Format(M商品(mintArCnt).int計上件数, "0000")
        MyStr = MyStr & Format(M商品(mintArCnt).intM優先, "0000")
        MyStr = MyStr & "(" & mintArCnt & ")"
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    For mintArCnt = 0 To UBound(varSortAry)
        MyStr = varSortAry(mintArCnt)
        lSortX = InStr(MyStr, "(")
        lSortY = InStr(MyStr, ")")
        mintCount = Mid(MyStr, lSortX + 1, lSortY - lSortX - 1)
        M商品(mintCount).int順位作成 = mintArCnt
    Next
End Function

'***********************************************
' 処理_合計金額パターン抽出
'***********************************************
Function 処理_合計金額パターン抽出(ByVal Target As Range) As Boolean
    Dim lX As Long
    '初期値セット
    mlngDataCnt = -1
    ReDim RData(0)
    giCountMax = UBound(M商品)
    giLayerMax = UBound(M商品) + 1
    M誤差.dbl予算金額 = CDec(Target)
    M誤差.dbl下限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差小))
    M誤差.dbl上限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差大))
    '自己参照パターン取得
    For lX = 1 To giLayerMax
        gintLayer = lX
        Call 自己参照(1, 0, "")
    Next
End Function

' ***********************************************
' 自己参照
' ***********************************************
Private Function 自己参照(iPLayer As Integer, iPNextCount As Integer, strParam As String) As Boolean
    Dim lX     As Long
    Dim lY     As Long
    Dim lZ     As Long
    Dim MyStr  As String
    For lX = iPNextCount To giCountMax
        If iPLayer < gintLayer Then
            If giCountMax > lX Then
                Call 自己参照(iPLayer + 1, lX + 1, strParam & "," & lX)
            End If
        Else
            MyStr = strParam & "," & lX:
            '-----------------------------------
            'Debug.Print Mid(MyStr, 2) 'デバッグ
            '-----------------------------------
            Dim tmp As Variant
            tmp = Split(Mid(MyStr, 2), ",")
            mdblKingaku = 0
            For mintCount = 0 To UBound(tmp)
                lZ = tmp(mintCount)
                mdblKingaku = CDec(mdblKingaku) + M商品(lZ).dblM金額
                If M誤差.dbl上限金額 < mdblKingaku Then Exit For
            Next
            If M誤差.dbl下限金額 <= mdblKingaku And mdblKingaku <= M誤差.dbl上限金額 Then
                Call パターンRecord作成処理(Mid(MyStr, 2), mdblKingaku)
            End If
        End If
    Next
End Function

'***********************************************
' パターンRecord作成処理
'***********************************************
Function パターンRecord作成処理(ByVal strPattern As String, ByVal dblKingaku As Double) As Boolean
    '定義
    Dim lX As Long
    Dim lY As Long
    Dim lZ As Long
    Dim MyStr As String
    'データRecord作成
    mlngDataCnt = mlngDataCnt + 1
    ReDim Preserve RData(mlngDataCnt)
    RData(mlngDataCnt).strPattern = strPattern
    RData(mlngDataCnt).str期限Key = ""
    RData(mlngDataCnt).str件数Key = ""
    RData(mlngDataCnt).str優先Key = ""
    RData(mlngDataCnt).dbl合計金額 = CDec(dblKingaku)
    'データ明細作成
    Dim tmp As Variant
    tmp = Split(strPattern, ",")
    lSortX = -1
    For lX = 0 To UBound(tmp)
        lZ = tmp(lX)
        MyStr = Format(M商品(lZ).int順位作成, "0000") & "-" & Format(lZ, "0000")
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    '明細設定
    lZ = -1
    With RData(mlngDataCnt)
        For lX = 0 To UBound(varSortAry)
            MyStr = varSortAry(lX)
            lY = Mid(MyStr, InStr(MyStr, "-") + 1)
            lZ = lZ + 1
            ReDim Preserve RData(mlngDataCnt).Rec明細(lZ)
            .Rec明細(lZ).str商品名称 = M商品(lY).strM名称
            .Rec明細(lZ).int期限区分 = M商品(lY).int期限区分
            .Rec明細(lZ).int計上件数 = M商品(lY).int計上件数
            .Rec明細(lZ).int優先順位 = M商品(lY).intM優先
            .Rec明細(lZ).lngセル行番 = M商品(lY).lngM行番
            If .Rec明細(lZ).int期限区分 = 1 Then
                If .str期限Key = "" Then
                    .str期限Key = 1
                Else
                    .str期限Key = CInt(.str期限Key) + 1
                End If
            End If
            .str件数Key = .str件数Key & Format(.Rec明細(lZ).int計上件数, "0000")
            .str優先Key = .str優先Key & Format(.Rec明細(lZ).int優先順位, "0000")
        Next
        If .str期限Key = "" Then .str期限Key = 0
    End With
End Function
```
続きあり

```VBA
'***********************************************
' 初期値取得
'***********************************************
Function 初期値取得() As Boolean
    '(処理済みSkip)
    If mblnMaster = True Then Exit Function
    '(取得WorkRange)
    Set rng商品域 = Range(str商品域)
    Set rng予算域 = Range(str予算域)
    Set rng結果域 = Range(str結果域)
    '(取得Masterデータ商品)
    mintArCnt = 0
    For Each mMyRange In Range(str商品域)
        ReDim Preserve M商品(mintArCnt)
        M商品(mintArCnt).strM名称 = Cells(mMyRange.Row, mMyRange.Column + 0)
        M商品(mintArCnt).dblM金額 = CDec(Cells(mMyRange.Row, mMyRange.Column + 1))
        M商品(mintArCnt).intM優先 = Cells(mMyRange.Row, mMyRange.Column + 2)
        M商品(mintArCnt).intM期限 = 0
        M商品(mintArCnt).lngM行番 = mMyRange.Row
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 0
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
        mintArCnt = mintArCnt + 1
    Next
    For Each mMyRange In Range(str期限商品域)
        For mintArCnt = 0 To UBound(M商品)
            If M商品(mintArCnt).strM名称 = mMyRange Then
                M商品(mintArCnt).intM期限 = Cells(mMyRange.Row, mMyRange.Column + 1)
                Exit For
            End If
        Next
        If M商品(mintArCnt).intM期限 = 0 Then M商品(mintArCnt).intM期限 = 9999
    Next
    '(取得Masterデータ予算)
    mintCount = 0
    mintArCnt = 0
    For Each mMyRange In Range(str予算域)
        ReDim Preserve M予算(mintArCnt)
        mintCount = mintCount + 1
        M予算(mintArCnt).int日目値 = mintCount
        M予算(mintArCnt).lng列位置 = mMyRange.Column
        mintArCnt = mintArCnt + 1
    Next
    '(取得Masterデータ誤差)
    M誤差.dblMst誤差小 = CDec(Range(str誤差小))
    M誤差.dblMst誤差大 = CDec(Range(str誤差大))
    M誤差.dbl合計金額 = 0
    M誤差.dbl予算金額 = 0
    M誤差.dbl下限金額 = 0
    M誤差.dbl上限金額 = 0
    '(初期値取得完了)
    mblnMaster = True
End Function

'***********************************************
' 処理開始
'***********************************************
Function 処理開始(ByVal Target As Range) As Boolean

    Call 初期値取得
    Call 処理_結果値情報取得(Target)
    Call 処理_合計金額パターン抽出(Target)
    If UBound(RData) = 0 Then
        MsgBox "該当金額なし"
        Exit Function
    End If
    Call 処理_最優先レコード選択
    Call 処理_結果書込み(Target)

End Function

'***********************************************
' 処理_結果値情報取得
'***********************************************
Function 処理_結果値情報取得(ByVal Target As Range) As Boolean
    Dim iWork As Integer
    Dim iCnt As Integer
    Dim i日目 As Integer
    Dim i期限日目 As Integer
    Dim MyStr As String
    '初期化
    For mintArCnt = 0 To UBound(M商品)
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 9
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
    Next
    'Target日目
    For mintArCnt = 0 To UBound(M予算)
        If M予算(mintArCnt).lng列位置 = Target.Column Then
            i日目 = M予算(mintArCnt).int日目値
            Exit For
        End If
    Next
    '取得処理
    mlRow1 = rng結果域.Row
    mlRow2 = mlRow1 + rng結果域.Rows.Count - 1
    mlCol1 = rng商品域.Column
    mlCol2 = Target.Column - 1
    mvarResData = Range(Cells(mlRow1, mlCol1), Cells(mlRow2, mlCol2)).Value
    For mintArCnt = 1 To UBound(mvarResData)
        iWork = mintArCnt - 1
        If mvarResData(mintArCnt, 1) = M商品(iWork).strM名称 Then
            iCnt = 0
            i期限日目 = 0
            For mintCount = UBound(mvarResData, 2) To 4 Step -1
                If mvarResData(mintArCnt, mintCount) = "○" Then
                    M商品(iWork).int計上件数 = M商品(iWork).int計上件数 + 1
                    If i期限日目 = 0 Then
                        i期限日目 = (M商品(iWork).intM期限 + M予算(mintCount - 4).int日目値)
                        M商品(iWork).int期限日数 = i期限日目
                        If i期限日目 <= i日目 Then
                            M商品(iWork).int期限区分 = 1
                        End If
                    End If
                End If
            Next
        End If
    Next
    '順位作成
    lSortX = -1
    For mintArCnt = 0 To UBound(M商品)
        MyStr = ""
        MyStr = MyStr & M商品(mintArCnt).int期限区分
        MyStr = MyStr & Format(M商品(mintArCnt).int計上件数, "0000")
        MyStr = MyStr & Format(M商品(mintArCnt).intM優先, "0000")
        MyStr = MyStr & "(" & mintArCnt & ")"
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    For mintArCnt = 0 To UBound(varSortAry)
        MyStr = varSortAry(mintArCnt)
        lSortX = InStr(MyStr, "(")
        lSortY = InStr(MyStr, ")")
        mintCount = Mid(MyStr, lSortX + 1, lSortY - lSortX - 1)
        M商品(mintCount).int順位作成 = mintArCnt
    Next
End Function

'***********************************************
' 処理_合計金額パターン抽出
'***********************************************
Function 処理_合計金額パターン抽出(ByVal Target As Range) As Boolean
    Dim lX As Long
    '初期値セット
    mlngDataCnt = -1
    ReDim RData(0)
    giCountMax = UBound(M商品)
    giLayerMax = UBound(M商品) + 1
    M誤差.dbl予算金額 = CDec(Target)
    M誤差.dbl下限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差小))
    M誤差.dbl上限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差大))
    '自己参照パターン取得
    For lX = 1 To giLayerMax
        gintLayer = lX
        Call 自己参照(1, 0, "")
    Next
End Function

' ***********************************************
' 自己参照
' ***********************************************
Private Function 自己参照(iPLayer As Integer, iPNextCount As Integer, strParam As String) As Boolean
    Dim lX     As Long
    Dim lY     As Long
    Dim lZ     As Long
    Dim MyStr  As String
    For lX = iPNextCount To giCountMax
        If iPLayer < gintLayer Then
            If giCountMax > lX Then
                Call 自己参照(iPLayer + 1, lX + 1, strParam & "," & lX)
            End If
        Else
            MyStr = strParam & "," & lX:
            '-----------------------------------
            'Debug.Print Mid(MyStr, 2) 'デバッグ
            '-----------------------------------
            Dim tmp As Variant
            tmp = Split(Mid(MyStr, 2), ",")
            mdblKingaku = 0
            For mintCount = 0 To UBound(tmp)
                lZ = tmp(mintCount)
                mdblKingaku = CDec(mdblKingaku) + M商品(lZ).dblM金額
                If M誤差.dbl上限金額 < mdblKingaku Then Exit For
            Next
            If M誤差.dbl下限金額 <= mdblKingaku And mdblKingaku <= M誤差.dbl上限金額 Then
                Call パターンRecord作成処理(Mid(MyStr, 2), mdblKingaku)
            End If
        End If
    Next
End Function

'***********************************************
' パターンRecord作成処理
'***********************************************
Function パターンRecord作成処理(ByVal strPattern As String, ByVal dblKingaku As Double) As Boolean
    '定義
    Dim lX As Long
    Dim lY As Long
    Dim lZ As Long
    Dim MyStr As String
    'データRecord作成
    mlngDataCnt = mlngDataCnt + 1
    ReDim Preserve RData(mlngDataCnt)
    RData(mlngDataCnt).strPattern = strPattern
    RData(mlngDataCnt).str期限Key = ""
    RData(mlngDataCnt).str件数Key = ""
    RData(mlngDataCnt).str優先Key = ""
    RData(mlngDataCnt).dbl合計金額 = CDec(dblKingaku)
    'データ明細作成
    Dim tmp As Variant
    tmp = Split(strPattern, ",")
    lSortX = -1
    For lX = 0 To UBound(tmp)
        lZ = tmp(lX)
        MyStr = Format(M商品(lZ).int順位作成, "0000") & "-" & Format(lZ, "0000")
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    '明細設定
    lZ = -1
    With RData(mlngDataCnt)
        For lX = 0 To UBound(varSortAry)
            MyStr = varSortAry(lX)
            lY = Mid(MyStr, InStr(MyStr, "-") + 1)
            lZ = lZ + 1
            ReDim Preserve RData(mlngDataCnt).Rec明細(lZ)
            .Rec明細(lZ).str商品名称 = M商品(lY).strM名称
            .Rec明細(lZ).int期限区分 = M商品(lY).int期限区分
            .Rec明細(lZ).int計上件数 = M商品(lY).int計上件数
            .Rec明細(lZ).int優先順位 = M商品(lY).intM優先
            .Rec明細(lZ).lngセル行番 = M商品(lY).lngM行番
            If .Rec明細(lZ).int期限区分 = 1 Then
                If .str期限Key = "" Then
                    .str期限Key = 1
                Else
                    .str期限Key = CInt(.str期限Key) + 1
                End If
            End If
            .str件数Key = .str件数Key & Format(.Rec明細(lZ).int計上件数, "0000")
            .str優先Key = .str優先Key & Format(.Rec明細(lZ).int優先順位, "0000")
        Next
        If .str期限Key = "" Then .str期限Key = 0
    End With
End Function
```
続きあり

```VBA
'***********************************************
' 初期値取得
'***********************************************
Function 初期値取得() As Boolean
    '(処理済みSkip)
    If mblnMaster = True Then Exit Function
    '(取得WorkRange)
    Set rng商品域 = Range(str商品域)
    Set rng予算域 = Range(str予算域)
    Set rng結果域 = Range(str結果域)
    '(取得Masterデータ商品)
    mintArCnt = 0
    For Each mMyRange In Range(str商品域)
        ReDim Preserve M商品(mintArCnt)
        M商品(mintArCnt).strM名称 = Cells(mMyRange.Row, mMyRange.Column + 0)
        M商品(mintArCnt).dblM金額 = CDec(Cells(mMyRange.Row, mMyRange.Column + 1))
        M商品(mintArCnt).intM優先 = Cells(mMyRange.Row, mMyRange.Column + 2)
        M商品(mintArCnt).intM期限 = 0
        M商品(mintArCnt).lngM行番 = mMyRange.Row
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 0
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
        mintArCnt = mintArCnt + 1
    Next
    For Each mMyRange In Range(str期限商品域)
        For mintArCnt = 0 To UBound(M商品)
            If M商品(mintArCnt).strM名称 = mMyRange Then
                M商品(mintArCnt).intM期限 = Cells(mMyRange.Row, mMyRange.Column + 1)
                Exit For
            End If
        Next
    Next
    '(取得Masterデータ予算)
    mintCount = 0
    mintArCnt = 0
    For Each mMyRange In Range(str予算域)
        ReDim Preserve M予算(mintArCnt)
        mintCount = mintCount + 1
        M予算(mintArCnt).int日目値 = mintCount
        M予算(mintArCnt).lng列位置 = mMyRange.Column
        mintArCnt = mintArCnt + 1
    Next
    '(取得Masterデータ誤差)
    M誤差.dblMst誤差小 = CDec(Range(str誤差小))
    M誤差.dblMst誤差大 = CDec(Range(str誤差大))
    M誤差.dbl合計金額 = 0
    M誤差.dbl予算金額 = 0
    M誤差.dbl下限金額 = 0
    M誤差.dbl上限金額 = 0
    '(初期値取得完了)
    mblnMaster = True
End Function

'***********************************************
' 処理開始
'***********************************************
Function 処理開始(ByVal Target As Range) As Boolean

    Call 初期値取得
    Call 処理_結果値情報取得(Target)
    Call 処理_合計金額パターン抽出(Target)
    If UBound(RData) = 0 Then
        MsgBox "該当金額なし"
        Exit Function
    End If
    Call 処理_最優先レコード選択
    Call 処理_結果書込み(Target)

End Function

'***********************************************
' 処理_結果値情報取得
'***********************************************
Function 処理_結果値情報取得(ByVal Target As Range) As Boolean
    Dim iWork As Integer
    Dim iCnt As Integer
    Dim i日目 As Integer
    Dim i期限日目 As Integer
    Dim MyStr As String
    '初期化
    For mintArCnt = 0 To UBound(M商品)
        M商品(mintArCnt).int計上件数 = 0
        M商品(mintArCnt).int期限区分 = 9
        M商品(mintArCnt).int期限日数 = 0
        M商品(mintArCnt).int順位作成 = 0
    Next
    'Target日目
    For mintArCnt = 0 To UBound(M予算)
        If M予算(mintArCnt).lng列位置 = Target.Column Then
            i日目 = M予算(mintArCnt).int日目値
            Exit For
        End If
    Next
    '取得処理
    mlRow1 = rng結果域.Row
    mlRow2 = mlRow1 + rng結果域.Rows.Count - 1
    mlCol1 = rng商品域.Column
    mlCol2 = Target.Column - 1
    mvarResData = Range(Cells(mlRow1, mlCol1), Cells(mlRow2, mlCol2)).Value
    For mintArCnt = 1 To UBound(mvarResData)
        iWork = mintArCnt - 1
        If mvarResData(mintArCnt, 1) = M商品(iWork).strM名称 Then
            iCnt = 0
            i期限日目 = 0
            For mintCount = UBound(mvarResData, 2) To 4 Step -1
                If mvarResData(mintArCnt, mintCount) = "○" Then
                    M商品(iWork).int計上件数 = M商品(iWork).int計上件数 + 1
                    If i期限日目 = 0 Then
                        i期限日目 = (M商品(iWork).intM期限 + M予算(mintCount - 4).int日目値)
                        M商品(iWork).int期限日数 = i期限日目
                        If i期限日目 <= i日目 Then
                            M商品(iWork).int期限区分 = 1
                        End If
                    End If
                End If
            Next
        End If
    Next
    '順位作成
    lSortX = -1
    For mintArCnt = 0 To UBound(M商品)
        MyStr = ""
        MyStr = MyStr & M商品(mintArCnt).int期限区分
        MyStr = MyStr & Format(M商品(mintArCnt).int計上件数, "0000")
        MyStr = MyStr & Format(M商品(mintArCnt).intM優先, "0000")
        MyStr = MyStr & "(" & mintArCnt & ")"
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    For mintArCnt = 0 To UBound(varSortAry)
        MyStr = varSortAry(mintArCnt)
        lSortX = InStr(MyStr, "(")
        lSortY = InStr(MyStr, ")")
        mintCount = Mid(MyStr, lSortX + 1, lSortY - lSortX - 1)
        M商品(mintCount).int順位作成 = mintArCnt
    Next
End Function

'***********************************************
' 処理_合計金額パターン抽出
'***********************************************
Function 処理_合計金額パターン抽出(ByVal Target As Range) As Boolean
    Dim lX As Long
    '初期値セット
    mlngDataCnt = -1
    ReDim RData(0)
    giCountMax = UBound(M商品)
    giLayerMax = UBound(M商品) + 1
    M誤差.dbl予算金額 = CDec(Target)
    M誤差.dbl下限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差小))
    M誤差.dbl上限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差大))
    '自己参照パターン取得
    For lX = 1 To giLayerMax
        gintLayer = lX
        Call 自己参照(1, 0, "")
    Next
End Function

' ***********************************************
' 自己参照
' ***********************************************
Private Function 自己参照(iPLayer As Integer, iPNextCount As Integer, strParam As String) As Boolean
    Dim lX     As Long
    Dim lY     As Long
    Dim lZ     As Long
    Dim MyStr  As String
    For lX = iPNextCount To giCountMax
        If iPLayer < gintLayer Then
            If giCountMax > lX Then
                Call 自己参照(iPLayer + 1, lX + 1, strParam & "," & lX)
            End If
        Else
            MyStr = strParam & "," & lX:
            '-----------------------------------
            'Debug.Print Mid(MyStr, 2) 'デバッグ
            '-----------------------------------
            Dim tmp As Variant
            tmp = Split(Mid(MyStr, 2), ",")
            mdblKingaku = 0
            For mintCount = 0 To UBound(tmp)
                lZ = tmp(mintCount)
                mdblKingaku = CDec(mdblKingaku) + M商品(lZ).dblM金額
                If M誤差.dbl上限金額 < mdblKingaku Then Exit For
            Next
            If M誤差.dbl下限金額 <= mdblKingaku And mdblKingaku <= M誤差.dbl上限金額 Then
                Call パターンRecord作成処理(Mid(MyStr, 2), mdblKingaku)
            End If
        End If
    Next
End Function

'***********************************************
' パターンRecord作成処理
'***********************************************
Function パターンRecord作成処理(ByVal strPattern As String, ByVal dblKingaku As Double) As Boolean
    '定義
    Dim lX As Long
    Dim lY As Long
    Dim lZ As Long
    Dim MyStr As String
    'データRecord作成
    mlngDataCnt = mlngDataCnt + 1
    ReDim Preserve RData(mlngDataCnt)
    RData(mlngDataCnt).strPattern = strPattern
    RData(mlngDataCnt).str期限Key = ""
    RData(mlngDataCnt).str件数Key = ""
    RData(mlngDataCnt).str優先Key = ""
    RData(mlngDataCnt).dbl合計金額 = CDec(dblKingaku)
    'データ明細作成
    Dim tmp As Variant
    tmp = Split(strPattern, ",")
    lSortX = -1
    For lX = 0 To UBound(tmp)
        lZ = tmp(lX)
        MyStr = Format(M商品(lZ).int順位作成, "0000") & "-" & Format(lZ, "0000")
        Call SortSet処理(MyStr)
    Next
    Call Sort処理
    '明細設定
    lZ = -1
    With RData(mlngDataCnt)
        For lX = 0 To UBound(varSortAry)
            MyStr = varSortAry(lX)
            lY = Mid(MyStr, InStr(MyStr, "-") + 1)
            lZ = lZ + 1
            ReDim Preserve RData(mlngDataCnt).Rec明細(lZ)
            .Rec明細(lZ).str商品名称 = M商品(lY).strM名称
            .Rec明細(lZ).int期限区分 = M商品(lY).int期限区分
            .Rec明細(lZ).int計上件数 = M商品(lY).int計上件数
            .Rec明細(lZ).int優先順位 = M商品(lY).intM優先
            .Rec明細(lZ).lngセル行番 = M商品(lY).lngM行番
            If .Rec明細(lZ).int期限区分 = 1 Then
                If .str期限Key = "" Then
                    .str期限Key = 1
                Else
                    .str期限Key = CInt(.str期限Key) + 1
                End If
            End If
            .str件数Key = .str件数Key & Format(.Rec明細(lZ).int計上件数, "0000")
            .str優先Key = .str優先Key & Format(.Rec明細(lZ).int優先順位, "0000")
        Next
        If .str期限Key = "" Then .str期限Key = 0
    End With
End Function
```
続きあり

@@ -1,3 +1,5 @@
+【頁No.2】
 ```VBA
 '***********************************************

@@ -64,6 +64,8 @@
         Next
+        If M商品(mintArCnt).intM期限 = 0 Then M商品(mintArCnt).intM期限 = 9999
     Next
     '(取得Masterデータ予算)

回答編集履歴