vba 如何使用带公式的 For Each 循环在 Excel 宏中填充多维数组？

How to Populate Multidimensional Array in Excel Macro using For Each Loop With Formula?

提问by Shubhajyoti Ghosh

I want to populate Array in VBA , using for each-loop but unable to do that

我想在 VBA 中填充 Array ，使用 for each-loop 但无法做到这一点

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

But ReDim Preserve MyArray(RowCounter, ColCounter)in this line I got subscript error, when ReDim Preserve MyArray(1, 0)

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

I want to read the value from excel sheet populate the array then do some calculation and update the value of Last Cell of the each Column in Excel from by Calculate Value of the Excel.

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

Update in code

代码更新

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

If within the codeI change the bellow line

如果在代码中我更改了波纹管

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

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

Now within MyArray(0,0)Value store As =IF((-16.8)<0,0,(-16.8))*IF((-16.8)<0,0,(-16.8))

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

But I want to store the value of the formula Withing MyArray(0,0) = ValueOftheFormula

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

采纳答案by Shubhajyoti Ghosh

OK Problem solved

OK 问题解决

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

回答by Kazimierz Jawor

As far as I can remember you can change size ONLY of the last array dimension.

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

To be sure I've just checked and it's true. According to MSDN:

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

If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all.

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

I don't know the ultimate goal of your sub therefore is difficult to suggest any changes. However, you could consider working with array of arrays. Syntax of such solution works as follows:

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

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

There are some disadvantages of such solution but could be useful in other situation.

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

回答by David Zemens

You could do simply:

你可以简单地做：

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

You will also need to For Each rCell In rRng.Rowsinstead of For Each rCell In rCol.Rows. Otherwise, like Kaz says, you can only resize the last dimension of an array.

您还需要For Each rCell In rRng.Rows代替For Each rCell In rCol.Rows. 否则，就像 Kaz 说的那样，您只能调整数组的最后一个维度的大小。

回答by Ioannis

I can see you have found a solution for your issue. For future reference, I would like to add an alternative way of going about this. In particular, I agree with @DavidZemens 's approach on copying the range values to a variant array directly. It is a very elegant, simple and efficient solution. The only tricky part is when there are empty or non-numeric cells in the range you are looking, and you do not want to insert these values. A modification of David's approach would work in case some of the values you are copying are not numbers.

我可以看到您已经为您的问题找到了解决方案。为了将来参考，我想添加一种替代方法来解决这个问题。特别是，我同意 @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

For more than 2 dimensions, jagged arrays is probably a good way to go (as suggested by @KazJaw)

对于超过 2 维，锯齿状数组可能是一个好方法（如@KazJaw 所建议的那样）