品物 5種類以下
各品物の個数 20個以下
金額の合計 数百万円以内
上のように問題を小規模なものに限定すれば単純なループ処理でも可能かと思われます。
(5種類,20個だと20^5=3200000回ループが必要)
使い方
A列1行目からAの各品物の値段を入力する
B列1行目からBの各品物の値段を入力する
Private Sub a_b()を実行する
以上
C,D,Eに結果が出力されます。
エラー処理はほとんどしていません。プログラムが暴走した場合はEscで中断する等ご自身で判断してください。
Option Explicit
Dim acnt As Long, bcnt As Long, lmt As Long, g As Long
Dim ap() As Long, bp() As Long, sumP() As Byte
Dim col As New Collection
Private Sub a_b()
Dim i As Long, j As Long, k As Long
acnt = InputBox("Aの品数を入力してください", Default:=5)
bcnt = InputBox("Bの品数を入力してください", Default:=5)
lmt = InputBox("品数の上限を入力してください", Default:=5)
ReDim ap(acnt - 1)
ReDim bp(acnt - 1)
For i = 0 To acnt - 1
ap(i) = Cells(i + 1, 1)
j = j + ap(i) * lmt
Next i
For i = 0 To bcnt - 1
bp(i) = Cells(i + 1, 2)
k = k + bp(i) * lmt
Next i
i = j: If j < k Then i = k
k = (10 ^ 6) * 5
If lmt ^ acnt > k Or lmt ^ bcnt > k Or i > k Then MsgBox "データが大きすぎるので処理を中止します", vbOKOnly: End
ReDim sumP(i)
Range("C1:E" & Rows.Count).ClearContents: g = 0
getab 0, ap(), 0, "", acnt, True
getab 0, bp(), 0, "", bcnt, False
Set col = Nothing
End
End Sub
Private Sub getab(ix As Long, pary() As Long, p As Long, s As String, lst As Long, flga As Boolean)
Dim i As Long
If ix <> lst Then
For i = 1 To lmt
getab ix + 1, pary(), p + pary(ix) * i, s & CStr(i) & ",", lst, flga
Next i
Else
If flga Then geta p, s
If Not flga Then getb p, s
End If
End Sub
Private Sub geta(p As Long, s As String)
If sumP(p) = 0 Then sumP(p) = 1: col.Add s, CStr(p)
End Sub
Private Sub getb(p As Long, s As String)
If sumP(p) = 1 Then
g = g + 1: Cells(g, 3) = col.Item(CStr(p)): Cells(g, 4) = s: Cells(g, 5) = p
End If
End Sub
お礼
有難うございました。 何とか成りそうですので使わせていただきます。 御礼が遅くなり申し訳ありませんでした