Excel VBA - 将公式结果分配给数组

时间:2015-12-06 19:53:04

标签: arrays excel vba excel-vba

这可以将值放在列中:

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  

1 个答案:

答案 0 :(得分:0)

当像Dim JR_Values(500)那样标注变体数组时,您将基于从零开始的索引创建一维数组。数组中的第一个元素是JR_Values(0),最后一个元素是JR_Values(500),共有501个数组元素。虽然你可以通过一点点数学从0到499工作,但你也可以通过声明它来强制变量数组上的一个基于索引。

当使用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

我留下了很多评论供您审核并随后进行清理。我最近写了一篇关于在How to assign the variable length of an array to integer variable中声明一维和二维变体数组的叙述。