Excel - 在 VBA 中，如何使用每行 1 个值找到矩阵中所有可能的值总和？答案

【问题标题】：Excel -- In VBA, how do I find all possible sums of values in a matrix using 1 value per row?Excel - 在 VBA 中，如何使用每行 1 个值找到矩阵中所有可能的值总和？
【发布时间】：2015-02-22 03:52:35
【问题描述】：

我已经搜索了很多这个答案，但没有什么能完全解决我的问题。这就是我正在做的事情......

我有一个包含 [edit: 16rows x 9cols] 矩阵的工作表。矩阵的单元格是正整数和负整数。以下是部分数据的示例：

我需要找到所有可能的求和，条件是每行只能选择一个值。换句话说，我会取每一行中的第一个值并将它们相加。然后，我将取第一行的第二个值并将其添加到所有其他行的第一个值中......一直到我找到每行最后一个值的总和。

首先，我想存储 (-144, -16, 0, -96, -74, 0, 589, -61, -55, -18, -66, 0, -279 , -24, -43, -406)。下一个要存储的总和将是 (-5, -16, 0, -96, -74, 0, 589, -61, -55, -18, -66, 0, -279, -24, -43, - 406）。

我正在尝试一种巧妙的方法来使用 For 循环和 GoTo 语句，但我愿意接受任何想法。也许是递归函数？

【问题讨论】：

你把求和的结果放在哪里？或者你想把它们放在哪里？
我想把它们拍到另一张纸上，但我对想法持开放态度。我计划对总和进行删除重复项。
我只是在测试我自己的一些想法，我想知道您是否知道 16x56 矩阵的组合数。从阅读您的 cmets 听起来组合的数量将是（列 ^ 行）。对于您拥有的示例数据，这将是 11^10 或 25937424601，这对于 excel 来说已经非常大了，更不用说进入 16x56 了……这个计数是否正确？
谢谢，@chancea。我能够删除大多数 0 并将其缩小为 16x9 矩阵。我会相应地更新我的帖子。
您的更新将组合数减少到略高于 8 * 10^9。仍然很多，但比 9^16 = 2 * 10^15 好。如果您可以生成所有这些组合，您会将结果存储在哪里？

标签： excel matrix vba

【解决方案1】：

可以通过递归解决这类问题，但我发现没有递归会更容易。

考虑一个速度计。每个循环将最右边的数字加一。如果该数字从 9 溢出到 0，则在左边的下一个数字上加 1。如果该数字溢出，则在其左侧的数字上加一。这一直持续到一个数字没有溢出或最左边的数字溢出。因此，您在速度计上看到的值是：

如果速度表的数字是整数数组中的条目，一个简单的循环可以循环这些值。

针对您的问题：

您的数组中需要 16 个条目，矩阵中每行一个。
每个数字可以取 0 到 55 之间的值，而不是 0 到 9。

进行此更改后，您的车速表将从：

  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0

到

 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55

如果您从 0 到 55 对列进行编号，则每个数字都会告诉您哪一列用于对应的行。

您的速度计循环的值之一是：

 1 45  5 30  8 22  1  0 38 51 14 42 29 31 46  7

告诉你求和：

Column 1 of first row
Column 45 of second row
Column 5 of third row
Column 30 of fourth row
And so on

另一个循环将提取这些值并求和。

因此，外部循环将使速度计从 {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} 循环到 {55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55}。对于速度表上的每个值，内部循环计算并存储总和。

第 2 节

为新需求更新原始代码需要进行少许更改。

在原始版本中，我有一个“速度计”，它从 (0, 0, 0, ...) 循环到 (55, 55, 55, ...)，每个“车轮”的值都在 0 到 55 之间。我现在有了添加了一个数组，为每个“轮子”提供最大值。例如，第一个“轮子”可以取值 0 到 5，对应于要从矩阵中提取的六个值：-144 -5 0 12 16 20。

  5  2  4  8  2  1  1  3  1  5  7  1  8  3  4  5    New maximum values

  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0    Minimum values

 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55    Old maximum values

我将矩阵图像中的数据输入到新工作簿的 Sheet1 中：

我的宏将该矩阵导入到变量数组中。每次访问变体类型的变量都会产生开销，因此我将数据复制到了 Long 数组中。为了演示宏正确地创建了数组，我输出：

Row Lst ---0 ---1 ---2 ---3 ---4 ---5 ---6 ---7 ---8
  0   5 -144   -5    0   12   16   20
  1   2  -16    0   50
  2   4    0    5    8   11   70
  3   8  -96  -57  -47  -45  -29  -13   -2    0    3
  4   2  -74  -18    0
  5   1    0    8
  6   1  589    0
  7   3  -61  -44  -26    0
  8   1  -55    0
  9   5  -18    0    9   18   50   58
 10   7  -66  -36    0    2   16   46   62   82
 11   1    0    8
 12   8 -279 -272 -253 -229 -165 -121  -74  -38    0
 13   3  -24  -19  -17    0
 14   4  -43  -27  -21   -9    0
 15   5 -406  -91  -64  -29   -3    0

“Lst”列给出每行的最后一个条目。

对于第一个版本的宏，我将前 200 个总和的诊断信息输出到 Sheet2：

这足以让我相信宏正确地循环速度计，正确地从矩阵中提取值并将这些值正确地求和。

对于宏的第二个版本，我删除了所有诊断代码并将总和输出到文件中。我在 1,000,000 次总和后切换文件以保持文件大小可管理。创建文件 50 后，宏退出。创建这 50 个文件需要 13 分 15 秒。第一个文件的顶部是：

然后我切换到 Visual Basic 2010。我用一个简单的表单创建了一个 Windows 应用程序：

我有六个控件，其中四个的名称如图所示，另一个 lblMessage 直到最后才可见。 lblFileNumMax 的值 8000 在运行时被计算的要创建的文件数替换。每次创建新文件时，lblFileNumCrnt 的值 1 都会更新。每分钟创建大约 100 个，这提供了足够的进度指示。

我本可以从 Excel 加载矩阵，但我认为硬编码更容易。除此之外，代码与 VBA 版本几乎没有区别。我保留了在创建 50 个文件后停止生成的陷阱，并使用批处理文件检查 VBA 文件是否与 VB 文件相同：

Del compare.txt
comp "Sums 0001.txt" "Sums 00001VBA.txt" <N.txt >>Compare.txt
comp "Sums 0002.txt" "Sums 00002VBA.txt" <N.txt >>Compare.txt
comp "Sums 0003.txt" "Sums 00003VBA.txt" <N.txt >>Compare.txt
comp "Sums 0004.txt" "Sums 00004VBA.txt" <N.txt >>Compare.txt
comp "Sums 0005.txt" "Sums 00005VBA.txt" <N.txt >>Compare.txt

然后我移除了陷阱，让程序在我的 2.1 GHz 笔记本电脑上创建所有 8063 文件，这需要 51 分 45 秒。

我无法发布 VBA 代码，因为我不小心删除了它以及总共 40 Gb 的 8063 文件，这些文件大到足以导致我的回收站溢出。

VB.net 代码如下。

Option Strict On
Imports System.IO

Public Class Form1
  Dim fileOut As StreamWriter
  Private Sub cmdStart_Click(sender As System.Object, e As System.EventArgs) Handles cmdStart.Click

    Dim matrix(,) As Integer = {{-144, -5, 0, 12, 16, 20, 0, 0, 0}, _
                                {-16, 0, 50, 0, 0, 0, 0, 0, 0}, _
                                {0, 5, 8, 11, 70, 0, 0, 0, 0}, _
                                {-96, -57, -47, -45, -29, -13, -2, 0, 3}, _
                                {-74, -18, 0, 0, 0, 0, 0, 0, 0}, _
                                {0, 8, 0, 0, 0, 0, 0, 0, 0}, _
                                {589, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                {-61, -44, -26, 0, 0, 0, 0, 0, 0}, _
                                {-55, 0, 0, 0, 0, 0, 0, 0, 0}, _
                                {-18, 0, 9, 18, 50, 58, 0, 0, 0}, _
                                {-66, -36, 0, 2, 16, 46, 62, 82, 0}, _
                                {0, 8, 0, 0, 0, 0, 0, 0, 0}, _
                                {-279, -272, -253, -229, -165, -121, -74, -38, 0}, _
                                {-24, -19, -17, 0, 0, 0, 0, 0, 0}, _
                                {-43, -27, -21, -9, 0, 0, 0, 0, 0}, _
                                {-406, -91, -64, -29, -3, 0, 0, 0, 0}}

    Dim lastEntryPerRow() As Integer = {5, 2, 4, 8, 2, 1, 1, 3, 1, 5, 7, 1, 8, 3, 4, 5}

    Const sumsPerFile As Long = 1000000

    Dim fileOutNum As Integer
    Dim fileOutNumMax As Long
    Dim finished As Boolean
    Dim numSums As Integer
    Dim pathProg As String
    Dim posChar As Int32
    Dim speedo() As Integer
    Dim sumCrnt As Integer
    Dim rowCrnt As Integer
    Dim rowMax As Integer = matrix.GetUpperBound(0)
    Dim timeStart As Long

    cmdStart.Visible = False
    cmdExit.Visible = False

    ' Extract folder containing program
    pathProg = Application.ExecutablePath
    posChar = InStrRev(pathProg, "\")
    If posChar <> 0 Then
      ' Discard the name of the program
      pathProg = Mid(pathProg, 1, posChar)
    End If

    ' Initialise Speedo to all zeros
    ReDim speedo(rowMax)
    For rowCrnt = 0 To rowMax
      speedo(rowCrnt) = 0
    Next

    ' Calculate number of files to be created
    fileOutNumMax = 1
    For rowCrnt = 0 To rowMax
      fileOutNumMax *= CLng(lastEntryPerRow(rowCrnt) + 1)
    Next
    fileOutNumMax = CInt(fileOutNumMax / sumsPerFile)

    lblFileNumMax.Text = CStr(fileOutNumMax)

    ' Initialise control variables
    numSums = 0
    fileOutNum = 1
    finished = False
    lblFileNumCrnt.Text = CStr(fileOutNum)
    Application.DoEvents()

    timeStart = (Hour(DateTime.Now) * 24 + Minute(DateTime.Now)) * 60 + Second(DateTime.Now)

    Do While True

      ' False means overwrite if file already exists
      fileOut = New StreamWriter(pathProg & "\Sums " & Format(fileOutNum, "0000") & ".txt", False)

      Do While True

        ' Output sum identified by current value of Speedo
        sumCrnt = 0
        numSums = numSums + 1
        For rowCrnt = 0 To rowMax
          sumCrnt += matrix(rowCrnt, speedo(rowCrnt))
        Next
        fileOut.WriteLine(sumCrnt)

        ' Generate next value for Speedo
        ' Process entries from left to right
        For rowCrnt = 0 To rowMax
          If speedo(rowCrnt) = lastEntryPerRow(rowCrnt) Then
            ' This column is about to overflow
            speedo(rowCrnt) = 0
            If rowCrnt = rowMax Then
              ' rightmost entry has overflowed. All done
              finished = True
              Exit Do
            End If
            ' Continue with For-Loop to step next column to right
          Else
            ' This column is not about to overflow
            speedo(rowCrnt) = speedo(rowCrnt) + 1
            ' Have finished generation
            Exit For
          End If
        Next

        If numSums >= sumsPerFile Then
          Exit Do
        End If

      Loop

      fileOut.Close()
      fileOut = Nothing
      numSums = 0
      fileOutNum = fileOutNum + 1
      'If fileOutNum >= 51 Then
      '  Exit Do
      'End If
      If finished Then
        Exit Do
      End If
      lblFileNumCrnt.Text = CStr(fileOutNum)
      Application.DoEvents()

    Loop

    Debug.Print(CStr((Hour(DateTime.Now) * 24 + Minute(DateTime.Now)) * 60 + _
                      Second(DateTime.Now) - timeStart) & " seconds")

    cmdExit.Visible = True

  End Sub
  Private Sub cmdExit_Click(sender As System.Object, e As System.EventArgs) Handles cmdExit.Click

    If fileOut IsNot Nothing Then
      fileOut.Close()
      fileOut = Nothing
    End If

    Me.Close()

  End Sub
End Class

【讨论】：

谢谢！这个答案感觉是对的。我理解它的理论，但我不熟悉将数组实现为循环的参数。你能给我指出正确的方向吗？
我是否需要为每一行设置一个循环层然后填充数组？
我现在正在测试外循环。我没有想到的是你会产生多少价值。 16^56 个值需要很长时间才能生成，并且需要大量存储空间。
谢谢，@Tony Dallimore。我在 15 到 20 分钟前发现我可以在 0 上进行 de-Dup。话虽如此，我每行只需要评估一个 0，因此我能够将数据压缩到 16row x 9col 矩阵。好多了。
生成第 11 到 15 列的所有值需要 2 秒。为第 10 到 15 列生成所有值需要 13 秒。为第 9 到 15 列生成所有值需要 116 秒。为第 8 到 15 列生成所有值需要 1,047 秒。每增加一列所需的时间大约是前一列的 9 倍。这将需要数年时间。