ナップサック問題をEXCEL VBAで解く

　こないだの記事の続きというか焼き直しです。

www.yomogi2017.xyz

　扱うのは同じ「0-1ナップサック問題」で、詳細を再掲します。

• 価値、重量がそれぞれ異なるアイテムがいくつかあり、定められた上限重量以内で価値が最大になるようにアイテムを選択する
  
• 1つのアイテムを分割したり2回以上選択することはできない
  
• 重量は整数とする

　解法も同様に動的計画法とします。

　ではやってみます。
　まずはワークシート。

入力部
　上限重量入力欄……B4
　アイテム価値/重量入力欄……B8:C107
　（ただし下記のコードは価値と重量の両方が入力されている限り、アイテムが100個を超えても処理します）
出力部
　価値総和表示欄……E4
　個々のアイテムの要否判定表示欄……E8:E107
　（ただし下記のコードはアイテムが100個を超えても表示します）

　あとは次のようなコードを標準モジュールに入力してドンと実行すればOK。
　やっぱりこっちの方がシンプルですね;-o-)

Sub knap_dp()

'dpメモ(上限重量10000まで対応),items要否結果
Dim dp(10000, 1) As Variant, items() As String
'iループ,jループ,vアイテム価値,w重量,max_w上限重量
Dim i As Variant, j As Integer, v As Variant, w As Variant, max_w As Integer
i = 0
max_w = Range("B4")

'読み込みと計算
    Do While True
    v = Range("B8").Offset(i, 0)
    w = Range("B8").Offset(i, 1)
        If v = "" Or w = "" Then
        Exit Do
        Else
            For j = max_w To 1 Step -1
                If j - w >= 0 Then
                    If dp(j, 0) < dp(j - w, 0) + v Then
                    dp(j, 0) = dp(j - w, 0) + v
                    dp(j, 1) = dp(j - w, 1) & i & ","
                    End If
                End If
            Next
        i = i + 1
        End If
    Loop

'結果表示
Range("E4") = dp(max_w, 0)
dp(max_w, 1) = Left(dp(max_w, 1), Len(dp(max_w, 1)) - 1)
items() = Split(dp(max_w, 1), ",")
Range("E8", Range("E8").Offset(i - 1, 0)) = ""
    For Each i In items()
    Range("E8").Offset(Val(i), 0) = "○"
    Next

End Sub

　インデントが不自然でした;-o-)その他もいろいろと雑でスミマセン。
　コメントに記載しているとおり設定できる上限重量は10000までです。拡張する場合は配列のカッコ内の10000を増やしてください。

　実行の様子です。
　アイテム数100、上限重量10000でもやってみましたがほとんど待たされませんのでそこそこ実用的かと思います。