基于AGGREGATE函数的多条件VBA自定义工作表函数开发求助

方法1：使用Evaluate模拟Excel单元格数组运算 #

直接在VBA里用Range做除法/乘法运算无法自动触发Excel的数组解析逻辑，而Evaluate可以让Excel引擎直接处理完整的公式字符串，完美复现单元格中输入公式的效果：

Dim result As Variant
' 直接传入公式字符串，注意双引号需要转义为两个双引号
result = Evaluate("AGGREGATE(14,6,A:A/(B:B=""YES"")*(C:C=""NO""),1)")

' 如果需要更清晰的代码结构，可以拆分公式字符串
Dim formulaStr As String
formulaStr = "AGGREGATE(14,6,A:A/(B:B=""YES"")*(C:C=""NO""),1)"
result = Evaluate(formulaStr)

这个方法最贴近原Excel公式的逻辑，无需手动处理数组筛选。

方法2：手动筛选符合条件的数值后传入AGGREGATE #

如果不想依赖公式字符串，可以先遍历数据，提取满足B="YES"且C="NO"的A列数值，再将这些数值组成数组传入WorksheetFunction.Aggregate：

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 指定目标工作表

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取有效数据最后一行，避免整列遍历浪费性能

Dim filteredVals() As Variant
ReDim filteredVals(1 To lastRow - 1) ' 假设第1行是表头
Dim count As Long
count = 0

Dim i As Long
For i = 2 To lastRow
    If ws.Cells(i, "B").Value = "YES" And ws.Cells(i, "C").Value = "NO" Then
        count = count + 1
        filteredVals(count) = ws.Cells(i, "A").Value
    End If
Next i

' 调整数组到实际有效元素数量
If count > 0 Then
    ReDim Preserve filteredVals(1 To count)
    Dim result As Variant
    result = WorksheetFunction.Aggregate(14, 6, filteredVals, 1)
    MsgBox "符合条件的最大值：" & result
Else
    MsgBox "无符合条件的数据"
End If

这种方法性能更优，尤其是数据量大时，避免了整列运算的冗余。

方法3：内存数组批量筛选（适合大数据量） #

将整批数据读到内存数组中遍历筛选，比逐个读取单元格快得多：

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")

Dim dataArr As Variant
' 读取A-C列的有效数据到内存数组
dataArr = ws.Range("A1:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value

Dim filteredVals() As Variant
ReDim filteredVals(1 To UBound(dataArr, 1) - 1)
Dim count As Long
count = 0

Dim i As Long
For i = 2 To UBound(dataArr, 1)
    If dataArr(i, 2) = "YES" And dataArr(i, 3) = "NO" Then
        count = count + 1
        filteredVals(count) = dataArr(i, 1)
    End If
Next i

If count > 0 Then
    ReDim Preserve filteredVals(1 To count)
    Dim result As Variant
    result = WorksheetFunction.Aggregate(14, 6, filteredVals, 1)
    Debug.Print result ' 结果输出到立即窗口
End If

原代码出错原因 #

VBA中直接执行Range("A:A")/(Range("B:B")="YES")会生成包含错误值的Variant数组，但WorksheetFunction.Aggregate无法像Excel单元格那样自动解析这种数组运算的逻辑，导致报错。以上方法要么通过Evaluate让Excel引擎处理公式，要么提前筛选出有效数值，避开了这个问题。

内容的提问来源于stack exchange，提问作者archil undilashvili