如何将数字的动态组合填入数组中

时间:2013-06-20 16:49:09

标签: arrays excel-vba multidimensional-array vba excel

在我的Excel工作表中,用户可以以最小,最大和步长值的形式输入1到5行数据。我想创建一个包含数据所有组合的多维数组。

有没有办法在VBA中对此进行编码以动态调整数组大小并循环遍历单元格值而不事先知道有多少数据项?

3行输入的示例数据(可以更多或更少)

     Min, Max, Step

数据1:1,10,1

数据2:10,50,10

数据3:5,25,5

总组合为250(10 x 5 x 5)

组合1:1,10,5

组合2:1,10,10

组合3:1,10,15

...

谢谢!

1 个答案:

答案 0 :(得分:0)

我发现你的问题有点不清楚,但我相信下面的宏会做你想要的。

如果您有变量Result,则可以将Result设置为数组。然后,您可以依次将Result(1),Result(1)(1),Result(1)(1)(1)等设置为嵌套数组。使用合适的递归例程,我相信您可以创建在Excel范围内寻找任何大小的数组。但是,我认为这种方法很难理解。

我不相信有一种更简单的方法来创建具有可变维数的数组。然而,改变尺寸的大小不是问题。

由于您最多有五个尺寸,我决定使用宽度为1的拖尾未使用尺寸的固定数量的尺寸。以您的示例(1到10步骤1,10到50步骤10,5到25步骤5),这将需要:

Dim Result(1 To 10, 1 To 5, 1 To 5, 1 To 1, 1 To 1)  

前三个维度有10,5和5个元素,可以保存一系列值。最后两个维度只是占位符。

您正在让用户输入维度详细信息。我已经从工作表“Dyn Dims”加载了详细信息。对于与您的示例匹配的测试,我将此工作表设置为:

Min Max Step
  1  10    1
 10  50   10
  5  25    5

我将此信息加载到长数组要求(1到3,1到5)。列是最小值,最大值和步长。行允许最多五个维度。如果第3列(步骤)为零,则不使用该尺寸。我不允许使用负步骤值,但如果有必要,请指出需要更改的位置。

您需要根据用户输入的数据初始化此数组。

从数组要求中,宏计算每个维度中的元素数量。我已经使用值测试了这个计算,例如1步2到10,其中没有N的值,使得Min + N * Step = Max。

宏然后根据需要维度数组Result。

您没有在数组中说出您想要的值,因此我将它们设置为“N:N:N”形式的值,其中Ns是Min-To-Max-Step计算中的值。我已经在宏中解释了这一点,在此不再重复。

最后,我将数组的内容输出到以日期和时间命名的文件中。在您的示例中,输出为:

Dimensions
   1   2   3   Value
   1   1   1   1:10:5
   2   1   1   2:10:5
   3   1   1   3:10:5
   4   1   1   4:10:5
   5   1   1   5:10:5
   6   1   1   6:10:5
   7   1   1   7:10:5
   8   1   1   8:10:5
   9   1   1   9:10:5
  10   1   1   10:10:5
   1   2   1   1:20:5
   :   :   :   :
   5   5   5   5:50:25
   6   5   5   6:50:25
   7   5   5   7:50:25
   8   5   5   8:50:25
   9   5   5   9:50:25
  10   5   5   10:50:25

我相信我已经提供了足够的评论来解释宏,但如有必要,可以回答问题。

Option Explicit
Sub DD()

  Const ColReqMin As Long = 1
  Const ColReqMax As Long = 2
  Const ColReqStep As Long = 3

  Dim DimCrnt As Long
  Dim Entry(1 To 5) As Long
  Dim EntryStepped As Boolean
  Dim FileOutNum As Long
  Dim Index(1 To 5) As Long
  Dim IndexStepped As Boolean
  Dim NumEntries(1 To 5) As Long
  Dim Requirements(1 To 3, 1 To 5) As Long
  Dim Result() As String
  Dim RowDDCrnt As Long
  Dim Stg As String
  Dim Value As String

  ' Load Requirements with the required ranges
  With Worksheets("Dyn Dims")
    RowDDCrnt = 2           ' First data row of worksheet Dyn Dims
    ' Note this macro does not check for blank lines in the middle
    ' of the table.
    For DimCrnt = 1 To 5
      If IsEmpty(.Cells(RowDDCrnt, ColReqStep)) Then
        ' No step value so this dimension not required for this run
        Requirements(ColReqStep, DimCrnt) = 0
      Else
        Requirements(ColReqMin, DimCrnt) = .Cells(RowDDCrnt, ColReqMin)
        Requirements(ColReqMax, DimCrnt) = .Cells(RowDDCrnt, ColReqMax)
        Requirements(ColReqStep, DimCrnt) = .Cells(RowDDCrnt, ColReqStep)
      End If
      RowDDCrnt = RowDDCrnt + 1
    Next
  End With

  ' Calculate number of entries for each dimension
  For DimCrnt = 1 To 5
    If Requirements(ColReqStep, DimCrnt) = 0 Then
      ' Dummy dimension
      NumEntries(DimCrnt) = 1
    Else
      NumEntries(DimCrnt) = (Requirements(ColReqMax, DimCrnt) - _
                             Requirements(ColReqMin, DimCrnt) + _
                             Requirements(ColReqStep, DimCrnt)) \ _
                            Requirements(ColReqStep, DimCrnt)
    End If
  Next

  ' Size array
  ReDim Result(1 To NumEntries(1), _
               1 To NumEntries(2), _
               1 To NumEntries(3), _
               1 To NumEntries(4), _
               1 To NumEntries(5))

  ' Initialise entry for each dimension to minimum value, if any,
  ' and index for each dimension to 1
  For DimCrnt = 1 To 5
    Index(DimCrnt) = 1
    If Requirements(ColReqStep, DimCrnt) <> 0 Then
      Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
    End If
  Next

  ' Starting with Entry(1), this loop steps the entry if the dimension is used.
  ' If the stepped entry is not greater than the maximum, then this repeat of
  ' the loop has finished.  If the stepped entry is greater than the maximum,
  ' it is reset to its minimum and the next entry stepped and checked in the
  ' same way.  If no entry is found that can be stepped, the loop is finished.
  ' If the dimensions after all 1 to 3 step 1, the values created by this loop
  ' are:
  '    1  1  1  1  1
  '    2  1  1  1  1
  '    3  1  1  1  1
  '    1  2  1  1  1
  '    2  2  1  1  1
  '    3  2  1  1  1
  '    1  3  1  1  1
  '    2  3  1  1  1
  '    3  3  1  1  1
  '    1  1  2  1  1
  '    2  1  2  1  1
  '    3  1  2  1  1
  '    :  :  :  :  :
  '    3  3  3  3  3

  Do While True

    ' Concatenate entries to create value for initial element
    ' or for element identified by last loop
    Value = Entry(1)
    For DimCrnt = 2 To 5
      If Requirements(ColReqStep, DimCrnt) = 0 Then
        Exit For
      End If
      Value = Value & ":" & Entry(DimCrnt)
    Next
    Result(Index(1), Index(2), Index(3), Index(4), Index(5)) = Value

    ' Find an entry to step
    EntryStepped = False
    For DimCrnt = 1 To 5
      If Requirements(ColReqStep, DimCrnt) = 0 Then
        Exit For
      End If
      Index(DimCrnt) = Index(DimCrnt) + 1
      Entry(DimCrnt) = Entry(DimCrnt) + _
                            Requirements(ColReqStep, DimCrnt)
      ' ### Changes required her if a negative step value is allow
      If Entry(DimCrnt) <= Requirements(ColReqMax, DimCrnt) Then
        ' This stepped entry is within permitted range
        EntryStepped = True
        Exit For
      End If
      ' This entry past its maximum so reset to minimum
      ' and let for loop step entry for next dimension
      Index(DimCrnt) = 1
      Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
    Next
    If Not EntryStepped Then
      ' All elements of Result initialised
      Exit Do
    End If

  Loop

  ' All elements of Result initialised
  ' Output values as test.

  FileOutNum = FreeFile

  Open ActiveWorkbook.Path & "\" & Format(Now(), "yymmdd hhmmss") & ".txt" _
       For Output As #FileOutNum

  ' Initialise Index
  For DimCrnt = 1 To 5
    Index(DimCrnt) = 1
  Next

  ' Create header line for table
  Print #FileOutNum, "Dimensions"
  Stg = ""
  For DimCrnt = 1 To 5
    If Requirements(ColReqStep, DimCrnt) = 0 Then
      Exit For
    End If
    Stg = Stg & Right("    " & DimCrnt, 4)
  Next
  Stg = Stg & "   Value"
  Print #FileOutNum, Stg

  ' Similar logic to loop that intialised Result but using Index and UBound.
  Do While True

    ' Output initial element or element identified by previous loop
    Stg = ""
    For DimCrnt = 1 To 5
      If Requirements(ColReqStep, DimCrnt) = 0 Then
        Exit For
      End If
      Stg = Stg & Right("    " & Index(DimCrnt), 4)
    Next
    Stg = Stg & "   " & Result(Index(1), Index(2), Index(3), Index(4), Index(5))
    Print #FileOutNum, Stg

    ' Identify next element, if any
    IndexStepped = False
    For DimCrnt = 1 To 5
      If Requirements(ColReqStep, DimCrnt) = 0 Then
        Exit For
      End If
      Index(DimCrnt) = Index(DimCrnt) + 1
      If Index(DimCrnt) <= UBound(Result, DimCrnt) Then
        IndexStepped = True
        Exit For
      Else
        Index(DimCrnt) = 1
      End If
    Next
    If Not IndexStepped Then
      ' All entries output
      Exit Do
    End If
  Loop

  Close #FileOutNum

End Sub