arrays - MS Access 中的 RANK.AVG Excel 函数

Question

我正在尝试在我的 MS ACCESS VBA 代码中使用 Excel 函数 RANK.AVG，但它给了我运行时错误“1004”。

这是我的代码：

Dim oExcel As Object
Set oExcel = CreateObject("excel.application")

For i = 0 To RowCount - 1
Arrfld4(i) = oExcel.Worksheetfunction.RANK.AVG(Arrfld1(i), Arrfld1())
Next i

Debug.Print vbNewLine

For i = 0 To RowCount - 1
    Debug.Print Arrfld4(i)
Next i

在 Arrfld1() 中是这些值：

 7 
 7 
 6 
 5 
 4 
 4 
 4 
 3 
 3 
 3 
 2 
 1 
 1 

我在 Arrfld4() 中的预期结果是：

 1,5 
 1,5 
 3 
 4 
 6 
 6 
 6 
 9 
 9 
 9 
 11 
 12,5 
 12,5

标签： arraysvbams-accessranking

Answer 1

您可以自己在数组上实现排名，尽管 VBA 提供的处理数组的工具很少，因此需要相当多的辅助函数。排名的实际逻辑并不复杂，因此很容易实现。

主要功能：

Public Function Array_Rank(vArray As Variant, Optional SortArray = False) As Double()
    Dim vOut() As Double
    ReDim vOut(LBound(vArray) To UBound(vArray))
    If SortArray Then Array_Bubblesort vArray
    Dim l As Long
    Dim t As Variant
    For l = LBound(vArray) To UBound(vArray)
        t = Array_Positions(vArray(l), vArray)
        Array_Increment 1 - LBound(vArray), t
        vOut(l) = Array_Avg(t)
    Next
    Array_Rank = vOut
End Function

辅助功能：

Public Function Array_Positions(vKey As Variant, vArray As Variant) As Long()
    Dim out() As Long
    Dim l As Long
    Dim pos As Long
    For l = LBound(vArray) To UBound(vArray)
        If vArray(l) = vKey Then
            ReDim Preserve out(pos)
            out(pos) = l
            pos = pos + 1
        End If
    Next
    Array_Positions = out
End Function

Public Sub Array_Increment(vOffset As Variant, ByRef vArray As Variant)
    Dim l As Long
    For l = LBound(vArray) To UBound(vArray)
        vArray(l) = vArray(l) + vOffset
    Next
End Sub

Public Function Array_Sum(vArray As Variant) As Variant
    Dim l As Long
    For l = LBound(vArray) To UBound(vArray)
        Array_Sum = Array_Sum + vArray(l)
    Next
End Function

Public Function Array_Count(vArray As Variant) As Long
    On Error Resume Next 'Will error on uninitialized arrays, return 0 in that case
    Array_Count = UBound(vArray) - LBound(vArray) + 1
End Function

Public Function Array_Avg(vArray As Variant) As Variant
    Array_Avg = Array_Sum(vArray) / Array_Count(vArray)
End Function

Public Sub Array_Bubblesort(ByRef vArray As Variant)
    Dim l As Long
    Dim iter As Long
    iter = 1
    Dim hasSwapped As Boolean
    hasSwapped = True
    Dim t As Variant
    Do While hasSwapped And iter <= UBound(vArray) - LBound(vArray)
        hasSwapped = False
        For l = LBound(vArray) To UBound(vArray) - iter
            If vArray(l) > vArray(l + 1) Then
                t = vArray(l)
                vArray(l) = vArray(l + 1)
                vArray(l + 1) = t
                hasSwapped = True
            End If
        Next
        iter = iter + 1
    Loop
End Sub

实现它很简单：

Arrfld4 = Array_Rank(Arrfld1)

你有你想要的阵列。

请注意，这并不是为了以最佳方式执行（主要Array_Positions可以重写为不需要Redim Preserve），但如果您在内存中有一个数组，它会比大多数其他解决方案更快。