如何使用evaluate方法将值填充到VBA数组中，并将其返回到Excel工作表？

我试图用VBA求值方法中的值填充数组。填充数组后，我想用数组中的值填充Excel工作表中的一系列单元格

我写了一个SUB来做我想做的事情，但是当我运行这个函数时，我得到了以下错误：

运行时错误9：下标超出范围

所以我的问题是：如何更正脚本以使max_min_date2正确运行？我的数据截图

---

据我所知，您希望显示每个股票代码的最长和最短日期。我不相信你一直在研究的公式会像预期的那样有效。这里有一个替代路线，通过数据透视表；你会很快得到结果的

将此代码粘贴到代码模块中：

Option Explicit

Public Sub CreateMaxDateByTickerPivotTable(ByVal prngTopLeftDataCell As Excel.Range, ByVal prngPivotTableTopLeft As Excel.Range, ByVal psPivotTableName As String)
    Dim pt As Excel.PivotTable

    Set pt = Nothing
    On Error Resume Next
    Set pt = prngPivotTableTopLeft.Worksheet.PivotTables(psPivotTableName)
    On Error GoTo 0

    If Not pt Is Nothing Then
        pt.TableRange2.Clear
    End If

    With ThisWorkbook.PivotCaches.Create(xlDatabase, prngTopLeftDataCell.CurrentRegion)
        With .CreatePivotTable(prngPivotTableTopLeft, psPivotTableName)
            .ShowValuesRow = False
            .CompactLayoutRowHeader = "Ticker"

            .ColumnGrand = False
            .RowGrand = False

            With .PivotFields("<ticker>")
                .Orientation = xlRowField
                .Position = 1
            End With

            .AddDataField .PivotFields("<date>"), "Max Date", xlMax
            .AddDataField .PivotFields("<date>"), "Min Date", xlMin
        End With
    End With

    Set pt = Nothing
End Sub

---

sub只需构建一个数据透视表，如果数据透视表已经存在，则将其删除，向下列出股票代码，并在每个股票代码的数据集中查找可用的最长和最短日期。

将值1到999作为变量进行调整，并删除下一行。您需要使用完全限定的引用或工作表。evaluate-Application.evaluate with unqualified refs始终假定活动的工作表是什么。如果希望保持现有的方式，然后您需要意识到值是一个二维数组，所有引用都需要包含第二维：valuesi-1,1=…谢谢，这很有效。接下来的一个问题是：如何让这个脚本运行得更快？当我在I=2到100之间运行此命令时，需要一段时间才能将值返回Excel，因此我想知道如何优化脚本，因为我的数据集中有大约75000行。使用最新编辑，它限制了ref数据的大小，并修复了最后一行上的错误@grantaguinaldo@grantaguinaldo如果这对你来说还是太慢了。发布工作代码以获得加速的想法。如果您想加速代码，请将其删除，然后在Excel中执行您想执行的任何操作。从VBA调用Excel函数1000次，只是将答案作为数组返回Excel，这似乎很奇怪。任何时候Excel和VBA之间出现问题都会产生开销。因此，为了加快代码的编写速度，只需在绝对必要的情况下向VBA引入一些东西，并一次性引入整个数据块，而不是逐个单元地引入，就可以减少这种开销。建议您编辑原始问题以描述此代码背后的业务逻辑，这将帮助人们找到更好的解决方案。

Sub max_min_date2()

'Define an array
Dim values As Variant
Dim LastRow As Long
Dim LastRow2 As Long
'set the worksheet
With Worksheets("Sheet1") 'Change to your sheet
    'get last row to avoid unnecessary loops
    LastRow = .Cells(.Rows.Count, 11).End(xlUp).Row
    'get last row of ref data to avoid unnecessary calculations
    LastRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    'Define the size of the array make it a two dimensional for ease of assigning back to array.
    ReDim values(1 To LastRow - 1, 1 To 1) As Variant

    'Set up for loop'
    For i = 2 To LastRow

        'Populate values in the array.
        values(i - 1, 1) = .Evaluate("=MAX(IF(A2:A" & LastRow2 & "=" & .Cells(i, 11).Address & ",B2:B" & LastRow2 & "))")

    Next i

    'Populate Excel sheet with values in the array.
    .Range("L2").Resize(LastRow - 1).Value = values

End With

End Sub

Option Explicit

Public Sub CreateMaxDateByTickerPivotTable(ByVal prngTopLeftDataCell As Excel.Range, ByVal prngPivotTableTopLeft As Excel.Range, ByVal psPivotTableName As String)
    Dim pt As Excel.PivotTable

    Set pt = Nothing
    On Error Resume Next
    Set pt = prngPivotTableTopLeft.Worksheet.PivotTables(psPivotTableName)
    On Error GoTo 0

    If Not pt Is Nothing Then
        pt.TableRange2.Clear
    End If

    With ThisWorkbook.PivotCaches.Create(xlDatabase, prngTopLeftDataCell.CurrentRegion)
        With .CreatePivotTable(prngPivotTableTopLeft, psPivotTableName)
            .ShowValuesRow = False
            .CompactLayoutRowHeader = "Ticker"

            .ColumnGrand = False
            .RowGrand = False

            With .PivotFields("<ticker>")
                .Orientation = xlRowField
                .Position = 1
            End With

            .AddDataField .PivotFields("<date>"), "Max Date", xlMax
            .AddDataField .PivotFields("<date>"), "Min Date", xlMin
        End With
    End With

    Set pt = Nothing
End Sub

CreateMaxDateByTickerPivotTable Sheet1.Range("A1"), Sheet1.Range("K1"), "MaxDateByTicker"