ナップザック関数
年度末になるとどーしても使う必要が出てきてしまうナップザック関数
一時的に必要に迫られて使うから、どーしても忘れちゃうのでメモしときます。
' knapsack総当たり ' 目標値と一致する物をすべて求める Const N = 20 ' データの数 Dim wa(N) As Long Sub knap_main() Dim w As Long, wmax As Long Dim i As Integer, j As Long, k As Integer Dim y1 As Integer, y2 As Integer Dim b As Long y1 = 1 ' A1:Anにデータを入れておく y2 = y1 + 1 ' B列以降が結果 For i = 1 To N wa(i) = Cells(i, y1).Value Next wmax = Cells(33, y1).Value ' A33に目標値を入れておく For j = 1 To 2 ^ N - 1 w = 0 b = 1 For k = 1 To N If j And b Then w = w + wa(k) b = b + b Next If w = wmax Then b = 1 For k = 1 To N If j And b Then Cells(k, y2).Value = wa(k) b = b + b Next y2 = y2 + 1 End If Next End Sub
ちなみに(y1=)に指定する数字はA,B,C,D~の列で左から数えた順になるから
データの入っている列の番号をここで指定すればA列にデータが無くてもOK
但し、結果を表示する部分(y2=)は上記ではy1の右隣以降を指定しているので、空欄にしておく必要がある。
上記太字部分に注意すること。
ついでに、できるだけ少ない組合せで探したい場合は別の方法を考える?
(ど素人なので、自分用のメモです・・・)