Excel VBA-將公式結果分配給數組

Question

這可以將值放在列中：

Sub JR_ArrayToDebugPint2()  
     ' written by Jack in the UK for [url]www.OzGrid.com[/url]  
     ' our web site [url]www.excel-it.com[/url]  
     ' Excel Xp+ 14th Aug 2004  
     ' [url]http://www.ozgrid.com/forum/showthread.php?t=38111[/url]  
    Dim JR_Values(500)  
    Dim JR_Count As Integer  
    Dim R As Long  
    R = 2  
    For JR_Count = 1 To 500 Step 1  
        JR_Values(JR_Count) = Evaluate("=INDEX('Client'!$O$2:$O$347473,MATCH(1,(('Client_Cost'!$D$2:$D$347473=BC" & CStr(R) & ")*('Client_Cost'!$E$2:$E$347473=BE" & CStr(R) & ")),0))")  
        Sheet1.Range("BG" & CStr(R) & "").Value = JR_Values(JR_Count)  
        R = R + 1  
        'Debug.Print JR_Values(JR_Count)  
        Next JR_Count  
End Sub

我已經修改了在mrexcel.com上找到的原始代碼

無論是Debug.Print還是打印到工作表，我都能獲得正確的值列表。 因此，在我看來，我應該能夠將計算所得的值放入數組中，然后使用Range（“ BG2：BG500”）。Value = Application.Transpose（myarray）。

我假設如果執行此操作，則這些值將一次全部放置在該列的單元格中，而不是一次放置一次，這就是該代碼以及我嘗試過的所有其他代碼所執行的操作。 我還假設，如果將值一次全部放入列的單元格中，則比一次將值一次放入單元格中要快得多。

我無法執行的操作是獲取公式計算后將值放入數組中的代碼。 我嘗試了以下各種變體，但均未成功-設置數組並讓數組采用計算值的語句用大寫表示，並用==>標記。 我最常見的錯誤是類型不匹配。

Sub JR_ArrayToDebugPint2()  
    Dim JR_Values(500)  
    Dim JR_Count As Integer  
    Dim R As Long  
 ==>   DIM arrPRICE(0 TO 500) AS VARIANT  
    R = 2  
    For JR_Count = 1 To 500 Step 1  
        JR_Values(JR_Count) = Evaluate("=INDEX('Client'!$O$2:$O$347473,MATCH(1,(('Client_Cost'!$D$2:$D$347473=BC" & CStr(R) & ")*('Client_Cost'!$E$2:$E$347473=BE" & CStr(R) & ")),0))")  
     ==>   arrPRICE(R) = JR_VALUES(JR_COUNT)  
        R = R + 1  
        'Debug.Print JR_Values(JR_Count)  
    Next JR_Count  
End Sub  

Answer 1

當您為Dim JR_Values(500)類的變量數組Dim JR_Values(500)尺寸時，您將基於從零開始的索引創建一維數組。 數組中的第一個元素是JR_Values(0) ，最后一個是JR_Values(500) ，總共501個數組元素。 雖然您可以在0到499的基礎上進行一些數學運算，但是您也可以通過這樣聲明來在變體數組上強制基於1的索引。

當使用Application Evaluate時，假設假定工作表中的BC和BE列的工作表父母身份是不確定的，就像在工作表上使用相同公式時一樣。 工作表知道是誰。 VBA可能會或可能不會知道您所暗示的工作表。

Sub JR_ArrayToDebugPint2()
    Dim olr As Long, rws As Long, JR_Count As Long, JR_Values As Variant

    'get some dimensions to the various data ranges
    With Worksheets("Client_Cost")
        'only use as many rows as absolutely necessary
        olr = Application.Min(.Cells(Rows.Count, "C").End(xlUp).Row, _
                              .Cells(Rows.Count, "E").End(xlUp).Row)
    End With
    With Worksheets("Client")
        rws = Application.Min(.Cells(Rows.Count, "BC").End(xlUp).Row, _
                              .Cells(Rows.Count, "BE").End(xlUp).Row)
        'override the above statement unless you want to run this overnight
        rws = 500
    End With

    ReDim JR_Values(1 To rws)   'force a one-based index on the array
    'Debug.Print LBound(JR_Values) & ":" & UBound(JR_Values)

    For JR_Count = LBound(JR_Values) To UBound(JR_Values) Step 1
        'Debug.Print Evaluate("INDEX('Client'!O2:O" & olr & _
                 ", MATCH(1, (('Client_Cost'!D2:D" & olr & "='Client'!BC" & JR_Count+1 & ")" & _
                            "*('Client_Cost'!E2:E" & olr & "='Client'!BE" & JR_Count+1 & ")), 0))")

        'R would be equal to JR_Count + 1 if R was still used (starts as R = 2)
        JR_Values(JR_Count) = _
          Evaluate("INDEX('Client'!O2:O" & olr & _
                 ", MATCH(1, (('Client_Cost'!D2:D" & olr & "='Client'!BC" & JR_Count + 1 & ")" & _
                            "*('Client_Cost'!E2:E" & olr & "='Client'!BE" & JR_Count + 1 & ")), 0))")
        'Debug.Print JR_Values(JR_Count)
    Next JR_Count

    With Worksheets("Client")
        .Range("BG2").Resize(UBound(JR_Values), 1) = Application.Transpose(JR_Values)
    End With

End Sub

我留下了很多評論供您查看，然后進行清理。 我最近在如何將數組的可變長度分配給整型變量中寫了一個聲明一維和二維變量數組的敘述。