如何在Excel宏中使用For Each Loop With Formula填充多維數組？

Question

我想填充在VBA陣列，使用每個循環，但不能這樣做，在這行

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中每列的Last Cell的值。

代碼更新

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

確定問題解決

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

Answer 2

據我記得，你可以改變最後一個數組維度的大小。

爲了確保我剛剛檢查過，它是真的。根據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 3

你可以做簡單：

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 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的建議）