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

我留下了很多评论供您查看，然后进行清理。 我最近在如何将数组的可变长度分配给整型变量中写了一个声明一维和二维变量数组的叙述。