'Sheet1の構成
'
'     | A  | B |      C       |  D  | E | F | G | H |
'  ---+----+---+--------------+-----+---+---+---+---+
'   1 | 11 |   | 目的値       |   8 |   |   |   |   |
'   2 |  9 |   | 最大要素数   |   3 |   |   |   |   |
'   3 |  7 |   | 最大件数     |  10 |   |   |   |   |
'   4 |  5 |   | 最大値初期値 | =D1 |   |   |   |   |
'   5 |  3 |   |              |     | 1 | 8 | 7 | 1 |
'   6 |  1 |   |              |     | 2 | 8 | 5 | 3 |
'

Option Explicit

Sub Test3()
    Dim a() As Integer     '値配列のインデックスを表現する配列
    Dim d As Integer       'インデックス配列のインデックス（木の深さ）
    Dim a1() As Double     '値の配列（降順ソート済み）
    Dim a2() As Double     '値配列の最小値からの累積和
    Dim a3() As Double     'インデックス配列に対応した累積和
    Dim n As Integer       '値配列の要素数
    Dim p As Double        '目的値
    Dim cnt As Integer     '出力件数
    Dim dMax As Integer    '最大要素数
    Dim cntMax As Integer  '最大出力件数
    Dim valMax As Double  '現在の最大値
    Dim i As Integer, j As Integer  '作業用
    Dim w As Double                 '作業用

    Dim range1 As Range, range2 As Range, sheet1 As Worksheet

    'ワークシートから値を取得
    Set sheet1 = Sheets("Sheet1")
    p = sheet1.Range("D1").Value
    dMax = sheet1.Range("D2").Value
    cntMax = sheet1.Range("D3").Value
    valMax = sheet1.Range("D4").Value
    
    Set range1 = sheet1.Range("A1").CurrentRegion
    n = range1.Rows.Count
    For i = 1 To range1.Rows.Count
        If range1.Cells(i, 1).Value <= p Then
            n = n - i + 1
            Exit For
        End If
    Next

    '出力範囲の設定
    Set range2 = sheet1.Range("E4")
    range2.Resize(1, sheet1.Columns.Count _
        - range2.Column + 1).EntireColumn.Clear


    '配列の定義
    ReDim a(0 To n)
    ReDim a1(1 To n)
    ReDim a2(1 To n + 1)
    ReDim a3(-1 To n)

    '値配列の作成
    With range1.Resize(n, 1).Offset(range1.Rows.Count - n)
        For i = 1 To n
            a1(i) = .Cells(i, 1).Value
        Next
    End With

    '値配列の累積和を作成
    a2(n) = a1(n)
    For i = n - 1 To 1 Step -1
        a2(i) = a2(i + 1) + a1(i)
    Next

    cnt = 0
    a(1) = 1
    a3(1) = a1(1)
    d = 1

    Do While d > 0 And a(d) <= n

        '確定値 > 目的値
        If a3(d) > p Then

        '確定値 = 目的値
        ElseIf a3(d) = p Then

            valMax = p

            '出力処理
            cnt = cnt + 1
            Set range2 = range2.Offset(1)
            range2.Value = cnt
            range2.Cells(1, 2).Value = p
            For i = 1 To d
                range2.Cells(1, i + 2).Value = a1(a(i))
            Next
            If cnt >= cntMax Then Exit Sub
            
        '確定値 + 未確定値最小 > 目的値
        ElseIf a3(d) + a1(n) > p Then
            
            '確定値 > 現在の最大値
            If a3(d) > valMax Then

                valMax = a3(d)

                '出力処理
                cnt = cnt + 1
                Set range2 = range2.Offset(1)
                range2.Value = cnt
                range2.Cells(1, 2).Value = valMax
                For i = 1 To d
                    range2.Cells(1, i + 2).Value = a1(a(i))
                Next
                If cnt >= cntMax Then Exit Sub
            End If
        
        Else

            '未確定部分の要素数と最大値を計算
            j = dMax - d
            If a(d) + j > n Then j = n - a(d)
            w = a3(d) + a2(a(d) + 1) - a2(a(d) + j + 1)

            '確定値 + 未確定値最大 < 目的値
            If w < p Then

                 '確定値 + 未確定値最大  > 現在の最大値
                If w > valMax Then

                    valMax = w

                    '出力処理
                    cnt = cnt + 1
                    Set range2 = range2.Offset(1)
                    range2.Value = cnt
                    range2.Cells(1, 2).Value = valMax
                    For i = 1 To d
                        range2.Cells(1, i + 2).Value = a1(a(i))
                    Next
                    For i = 1 To j
                        range2.Cells(1, d + 2 + i).Value = a1(a(d) + i)
                    Next
                    If cnt >= cntMax Then Exit Sub
                End If

            '確定値 + 未確定値最大 = 目的値
            ElseIf w = p Then

                valMax = p

                '出力処理
                cnt = cnt + 1
                Set range2 = range2.Offset(1)
                range2.Value = cnt
                range2.Cells(1, 2).Value = p
                For i = 1 To d
                    range2.Cells(1, i + 2).Value = a1(a(i))
                Next
                For i = 1 To j
                    range2.Cells(1, d + 2 + i).Value = a1(a(d) + i)
                Next
                If cnt >= cntMax Then Exit Sub

            ElseIf a(d) < n And d < dMax Then
                
                '現在の枝を伸ばす
                d = d + 1
                a(d) = a(d - 1) + 1
                a3(d) = a3(d - 1) + a1(a(d))
                GoTo continue

            End If
        End If

        '次の枝を作成
        If a(d) >= n Then d = d - 1
        a(d) = a(d) + 1
        a3(d) = a3(d - 1) + a1(a(d))

continue:
    Loop

End Sub