在MS Access VBA中调用Excel RANK.AVG函数遇运行时错误'1004'求助

你遇到的这个错误，核心原因是Excel的WorksheetFunction.RANK.AVG不支持直接接收VBA本地数组作为参数——它期望的是Excel工作表的单元格区域，或是在Excel环境中创建的数组对象，直接传VBA数组就会触发1004错误。

下面给你两种可行的解决办法：

方法一：借助临时Excel工作表处理数组 #

我们可以先把VBA数组写入Excel的临时工作表，再调用RANK.AVG计算，最后把结果读回VBA数组，步骤如下：

Dim oExcel As Object
Dim oWorkbook As Object
Dim oWorksheet As Object
Dim i As Integer
Dim RowCount As Integer

' 初始化你的数据数组
RowCount = 13
Dim Arrfld1(12) As Variant
Arrfld1 = Array(7, 7, 6, 5, 4, 4, 4, 3, 3, 3, 2, 1, 1)
Dim Arrfld4(12) As Variant

' 启动Excel后台进程
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = False ' 不显示Excel窗口，避免干扰
Set oWorkbook = oExcel.Workbooks.Add
Set oWorksheet = oWorkbook.Worksheets(1)

' 将VBA数组转置后写入Excel的A列（因为Excel列方向数组需要转置）
oWorksheet.Range("A1:A" & RowCount).Value = oExcel.Transpose(Arrfld1)

' 调用RANK.AVG计算排名
For i = 0 To RowCount - 1
    Arrfld4(i) = oExcel.WorksheetFunction.RANK.AVG(oWorksheet.Cells(i + 1, 1), oWorksheet.Range("A1:A" & RowCount))
Next i

' 输出结果到立即窗口
Debug.Print vbNewLine
For i = 0 To RowCount - 1
    Debug.Print Arrfld4(i)
Next i

' 清理资源，务必关闭Excel进程，避免残留
oWorkbook.Close SaveChanges:=False
oExcel.Quit
Set oWorksheet = Nothing
Set oWorkbook = Nothing
Set oExcel = Nothing

方法二：手动实现RANK.AVG逻辑（无需依赖Excel） #

如果不想启动Excel进程，完全可以在VBA里自己实现RANK.AVG的平均排名逻辑，这样更轻量也更稳定：

' 自定义函数实现RANK.AVG的平均排名逻辑
Function RankAvg(ByVal targetValue As Variant, sourceArr As Variant) As Double
    Dim totalElements As Integer
    Dim higherCount As Integer
    Dim sameValueCount As Integer
    Dim i As Integer
    
    totalElements = UBound(sourceArr) - LBound(sourceArr) + 1
    higherCount = 0
    sameValueCount = 0
    
    ' 统计比目标值大的元素数量，以及和目标值相等的元素数量
    For i = LBound(sourceArr) To UBound(sourceArr)
        If sourceArr(i) > targetValue Then
            higherCount = higherCount + 1
        ElseIf sourceArr(i) = targetValue Then
            sameValueCount = sameValueCount + 1
        End If
    Next i
    
    ' 平均排名计算公式：(大于当前值的数量*2 + 相同值数量 + 1)/2
    RankAvg = (higherCount * 2 + sameValueCount + 1) / 2
End Function

' 测试自定义函数的调用示例
Sub TestCustomRankAvg()
    Dim Arrfld1() As Variant
    Dim Arrfld4() As Variant
    Dim i As Integer
    
    Arrfld1 = Array(7, 7, 6, 5, 4, 4, 4, 3, 3, 3, 2, 1, 1)
    ReDim Arrfld4(LBound(Arrfld1) To UBound(Arrfld1))
    
    ' 遍历计算每个元素的平均排名
    For i = LBound(Arrfld1) To UBound(Arrfld1)
        Arrfld4(i) = RankAvg(Arrfld1(i), Arrfld1)
    Next i
    
    ' 输出结果到立即窗口
    Debug.Print vbNewLine
    For i = LBound(Arrfld1) To UBound(Arrfld1)
        Debug.Print Arrfld4(i)
    Next i
End Sub

两种方法都能得到你期望的结果：1.5, 1.5, 3, 4, 6, 6, 6, 9, 9, 9, 11, 12.5, 12.5（注意VBA里小数用点而不是逗号）。

内容的提问来源于stack exchange，提问作者Tomáš Ulrich