如何使用For Each Loop With Formula在Excel宏中填充多维数组

Question

我想在VBA中填充Array，对每个循环使用，但无法执行

Dim MyArray() As Variant
Dim RowCounter As Integer
Dim ColCounter As Integer
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("B10:Z97")
RowCounter = 0
ColCounter = 0
ReDim MyArray(rRng.Rows.Count, rRng.Columns.Count)  'Answer by @varocarbas
For Each rCol In rRng.Columns
   For Each rCell In rCol.Rows
    If IsNumeric(rCell.Value) And (Not (IsEmpty(rCell.Value))) And (Len(rCell.Value) <> 0) Then
         'ReDim Preserve MyArray(RowCounter, ColCounter) -- Old Logic which cause Error
         MyArray(RowCounter, ColCounter) = rCell.Value
         RowCounter = RowCounter + 1
    Else
        'Debug.Print rCell.Value & " is not an Integer" & vbNewLine
    End If
  Next rCell
  ColCounter = ColCounter + 1
  RowCounter = 0
Next rCol

但是ReDim Preserve MyArray(RowCounter, ColCounter)在这一行中，当ReDim Preserve MyArray(1, 0) 时，我得到了下标错误

我想从excel表中读取值，填充数组，然后进行一些计算，并通过计算excel的值来更新excel中每列的最后一个单元格的值。

代码更新

Function RunSquareOfVariance(temperature As Integer, cellValue As Variant) As Double
         RunSquareOfVariance = "=IF((" & temperature + cellValue & ")<0,0,(" & temperature + cellValue & "))*IF((" & temperature + cellValue & ")<0,0,(" & temperature + cellValue & "))"
End Function

如果在代码内，我会更改下面的行

MyArray(RowCounter, ColCounter) = RunSquareOfVariance(StantardTemperature, rCell.Value)

现在在MyArray（0,0）值存储为=IF((-16.8)<0,0,(-16.8))*IF((-16.8)<0,0,(-16.8))

但是我想存储公式的值Withing MyArray(0,0) = ValueOftheFormula

Answer 1

据我所知，您只能更改最后一个数组维度的大小。

可以肯定的是，我刚刚检查过，这是真的。根据MSDN：

如果使用Preserve关键字，则只能调整最后一个数组的大小维度，并且根本无法更改维度的数量。

我不知道你的潜艇的最终目标，因此很难提出任何改变。不过，您可以考虑使用数组数组。这种解决方案的语法如下：

Dim arrA() As Variant
Dim arrB() As Variant
...
ReDim Preserve arrA(RowCounter)
ReDim Preserve arrB(ColCounter)
...
arrA(RowCounter) = x
arrB(ColCounter) = y
...
Dim arrAB
arrAB = Array(arrA, arrB)
...
'to get elements of array you need to call it in this way:
arrAB(0)(RowCounter) >> to get x
arrAB(1)(ColCounter) >> to get y

这种解决方案有一些缺点，但在其他情况下可能有用。

Answer 2

您可以简单地执行以下操作：

Dim rng As Range
Dim myArray() As Variant
Set rRng =  Sheet1.Range("B10:Z97")
myArray = rRng.Value

您还需要For Each rCell In rRng.Rows而不是For Each rCell In rCol.Rows。否则，就像Kaz说的，你只能调整数组的最后一个维度。

Answer 3

OK问题已解决

MyArray(RowCounter, ColCounter) = Application.Evaluate
        (
          RunSquareOfVariance(StantardTemperature, rCell.Value)
        )

Answer 4

我可以看出您已经为您的问题找到了解决方案。为了将来参考，我想添加一种替代方法。特别是，我同意@DavidZemens将范围值直接复制到变量数组的方法。这是一个非常优雅、简单和高效的解决方案。唯一棘手的部分是，当您正在查找的区域中有空单元格或非数字单元格，并且您不想插入这些值时。如果您正在复制的某些值不是数字，那么修改David的方法将起作用。

Sub CopyNumbersToArray()
Dim var As Variant, rng As Range
' Grab the numeric values of the range only. Checking if cell is empty or
' if it has a positive length is not needed
Set rng = Range("B3:K3").SpecialCells(xlCellTypeConstants, xlNumbers)
' Copy the numbers. Note that var=rng.value will not work if rng is not contiguous
rng.Copy
' Paste the numbers temporarily to a range that you do not use
Range("A10000").Resize(1, rng.Count).PasteSpecial xlPasteValues
' Set rng object to point to that range
Set rng = Range(Cells(10000, 1), Cells(10000, rng.Count))
' Store the values that you need in a variant array
var = rng.Value
' Clear the contents of the temporary range
rng.ClearContents
End Sub

对于超过2个维度，锯齿状阵列可能是一个很好的方法（正如@KazJaw所建议的）