Excel——在VBA中,如何使用每行1个值来查找矩阵中所有可能的值和?

Excel——在VBA中,如何使用每行1个值来查找矩阵中所有可能的值和?,excel,matrix,vba,Excel,Matrix,Vba,我已经搜索了很多关于这个问题的答案,但是没有什么能完全解决我的问题。这是我正在做的 我有一个工作表,其中包含一个矩阵[edit:16行x 9列]。矩阵的单元格是正整数和负整数。以下是部分数据的示例: 我需要找到所有可能的求和,条件是每行只能选择一个值。换句话说,我将取每行的第一个值并将它们相加。然后,我将取第一行的第二个值,并将其添加到所有其他行的第一个值……不断地,直到找到每行最后一个值的总和 首先,我想存储(-144,-16,0,-96,-74,0589,-61,-55,-18,-66,0

我已经搜索了很多关于这个问题的答案,但是没有什么能完全解决我的问题。这是我正在做的

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

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

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


我正试图想出一种聪明的方法,使用
For
循环和
GoTo
语句,但我愿意接受任何想法。也许是递归函数?

使用递归可以解决此类问题,但我发现没有递归更容易

以速度计为例。每个周期最右边的数字加一。如果该数字从九溢出到零,则在左边的下一个数字上加一。如果该数字溢出,则在其左侧的数字上添加一个。这将一直持续到某个数字没有溢出或最左边的数字溢出为止。因此,您在车速表上看到的值是:

0 0 0 0
0 0 0 1
0 0 0 2
: : : :
0 0 0 9
0 0 1 0
0 0 1 1
: : : :
0 0 1 9
0 0 2 0
: : : :
0 0 9 9
0 1 0 0
: : : :
9 9 9 9
如果车速表的数字是整数数组中的条目,则可以通过一个简单的循环遍历这些值

对于您的问题:

  • 数组中需要16个条目,矩阵中每行一个
  • 每个数字的取值范围为0到55,而不是0到9
通过此更改,您的车速表从以下位置循环:

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

如果对列进行编号,从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}循环到{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中:

我的宏将该矩阵导入变量数组。每次访问variant类型的变量都会有开销,因此我将数据复制到一个长数组中。为了演示宏如何正确创建数组,我将输出:

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个和的诊断信息输出到表2:

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

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

然后我切换到VisualBasic2010。我用一个简单的表单创建了一个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
Del compare.txt
comp“Sums 0001.txt”Sums 00001VBA.txt“>Compare.txt
comp“Sums 0002.txt”Sums 00002VBA.txt“>Compare.txt
comp“Sums 0003.txt”Sums 00003VBA.txt“>Compare.txt
comp“Sums 0004.txt”Sums 00004VBA.txt“>Compare.txt
comp“Sums 0005.txt”Sums 00005VBA.txt“>Compare.txt
然后我移除了陷阱,让程序在我的2.1GHz笔记本电脑上创建所有8063个文件,耗时51分45秒

我无法发布VBA代码,因为我不小心删除了它以及总共40GB的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
选项严格打开
导入System.IO
公开课表格1
将文件输出设置为StreamWriter
私有子cmdStart\u单击(发件人作为System.Object,e作为System.EventArgs)处理cmdStart。单击
Dim矩阵(,)作为整数={{-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}, _
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