タグ: ナップサック

ナップザック関数

年度末になるとどーしても使う必要が出てきてしまうナップザック関数
一時的に必要に迫られて使うから、どーしても忘れちゃうのでメモしときます。

' 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の右隣以降を指定しているので、空欄にしておく必要がある。
上記太字部分に注意すること。
ついでに、できるだけ少ない組合せで探したい場合は別の方法を考える？
（ど素人なので、自分用のメモです・・・）

trekkINNで個人輸入した話。その2

一意の値になる数値の組み合わせを探すには・・・

ナップザック関数