Excel VBA的组合算法答案

【问题标题】：Combinational algorithm for Excel VBAExcel VBA的组合算法
【发布时间】：2016-02-11 17:47:01
【问题描述】：

假设我有一组项目，如下所示：

Item    Units
Apples    5
Pears     5
Carrots   1
Oranges   4

我有六个人可以将这些物品送给他们。让我们称呼他们：

Mr. A
Mr. B
Mr. C
Mr. D
Mr. E
Mr. F

我需要一个 Excel VBA 代码来检索将上述项目共享给不同人的所有潜在组合。请注意，(i) 订单并不重要，并且 (ii) 一个人可能拥有多个相同商品的单位。

为了报告此信息，我正在考虑类似于以下所示的结构：

                          Mr A                                 Mr B                   ...
             Apples  Pears  Carrots  Oranges       Apples  Pears  Carrots  Oranges    ...
Scenario 1     1       0       1        2             2      2       0        0       ...
Scenario 2     1       0       1        1             2      2       0        0       ...
...

我知道组合的数量会很大，但不介意计算要求。

我一直在尝试找出算法，但未能实现。

提前致谢，

【问题讨论】：

您可能已经知道这一点，但是如果您发布您尝试过的代码，您将获得更多帮助。如果您还没有，请阅读How To Ask。如果您不提供您的编码工作以及他们失败的地方，那么问题很可能会被关闭。
问题是我之前通过 Excel 公式实现了类似的组合算法。但是，在这种情况下，我不知道如何解决这样一个事实，即我可能将多个单元分配给同一个人，我之前也没有看到任何关于此问题的帖子。
一个人可以拥有的每件物品的最大数量是多少？每个人可以拥有的所有物品的总数是否有上限？如果不是，那么答案是有无数种可能的组合，因此是无限循环。
每个人可以拥有的每件物品的最大数量受该物品的单位数量限制。例如，A 先生可以有 5 个苹果，而其他人则没有。一个人可以拥有的最大物品总数没有任何限制。

标签： excel algorithm vba combinations

【解决方案1】：

我尝试使用 Mr A 和 Mr B 进行测试，有 360 种不同的场景。

Sub distr_list()
Dim apple_a, apple_b

Count = 1

Cells(Count, 4) = "apple_a"
Cells(Count, 5) = "pear_a"
Cells(Count, 6) = "carrot_a"
Cells(Count, 7) = "orange_a"

Cells(Count, 9) = "apple_b"
Cells(Count, 10) = "pear_b"
Cells(Count, 11) = "carrot_b"
Cells(Count, 12) = "orange_b"

For apple_a = 0 To 5
For apple_b = 0 To 5

For pear_a = 0 To 5
For pear_b = 0 To 5

For carrot_a = 0 To 1
For carrot_b = 0 To 1

For orange_a = 0 To 4
For orange_b = 0 To 4


 If apple_a + apple_b = 5 Then
    If pear_a + pear_b = 5 Then
        If carrot_a + carrot_b = 1 Then
            If orange_a + orange_b = 4 Then

    Cells(Count + 1, 4) = apple_a
    Cells(Count + 1, 5) = pear_a
    Cells(Count + 1, 6) = carrot_a
    Cells(Count + 1, 7) = orange_a

    Cells(Count + 1, 9) = apple_b
    Cells(Count + 1, 10) = pear_b
    Cells(Count + 1, 11) = carrot_b
    Cells(Count + 1, 12) = orange_b

    Count = Count + 1

 End If
 End If
 End If
 End If

Next
Next
Next
Next
Next
Next
Next
Next

End Sub

您可以对其余部分应用相同的逻辑。

【讨论】：