VBA - 在[Range derived] Variant数组上运行WorksheetFunction?

时间:2014-07-22 00:50:28

标签: excel vba excel-vba

我需要在单个输入矩阵上运行内置excel函数的连续传递。

问题是,输入[range]是我假设的,指针常量。

当然,我可以对WorkSheetFunction输入进行[range]计算,并将输出放入变体中。

但是,我确实需要对变体数据运行更多传递。我有一个更高级的计算,将对使用标准excel函数(如平均值和中位数)的数据运行4次转换。

这是我的代码

Public Function RankECDF(ByRef r_values As Range, Optional ByVal zeroFlag As Boolean = 0) As Variant()

Dim i As Integer, j As Integer, N As Integer, M As Integer

Dim total As Integer

Dim y() As Variant

N = r_values.Rows.Count
M = r_values.Columns.Count

y = r_values.Value    'copy values from sheet into an array

Dim V() As Variant
Dim AltV As Variant

Dim OutV As Variant
Dim OutAltV As Variant

'quite possible to makes the Variant larger to hold the "other arrays"

ReDim V(1 To N, 1 To M)
ReDim AltV(1 To N, 1 To M)

ReDim OutV(1 To N, 1 To M)
ReDim OutAltV(1 To N, 1 To M)

'first pass just checks for zero's.  Could speed this process up by implementing the zeroFlag check to skip the double loop

total = WorksheetFunction.Sum(r_values)
For R = 1 To N
    For C = 1 To M
        If y(R, C) = "" Then
            V(R, C) = ""
            AltV(R, C) = 0
        Else
            'would error if cell was ""
            'V(R, C) = WorksheetFunction.Average(WorksheetFunction.Rank(y(R, C), r_values, 1), WorksheetFunction.CountIf(r_values, "<=" & y(R, C))) / WorksheetFunction.Count(r_values)
            V(R, C) = y(R, C)
            AltV(R, C) = y(R, C)
        End If
    Next C
Next R

'second loop does rankecdf conversions
For RA = 1 To N
    For CA = 1 To M
       'OutV(RA, CA) = 1
       'OutV(RA, CA) = WorksheetFunction.Rank(V(RA, CA), V, 1)

       'OutAltV(RA, CA) = 2
       'OutAltV(RA, CA) = WorksheetFunction.Average(WorksheetFunction.Rank(y(RA, CA), r_values, 1), WorksheetFunction.CountIf(r_values, "<=" & y(RA, CA))) / WorksheetFunction.Count(r_values)
    Next CA
Next RA

If (zeroFlag) Then
    RankECDF = AltV
    'RankECDF = OutAltV(1 to N, 1 to M)
Else
    RankECDF = V
    'RankECDF = OutV(N, M)
End If

End Function

问题可以在这里找到:

OutV(RA, CA) = WorksheetFunction.Rank(V(RA, CA), V, 1)

2 个答案:

答案 0 :(得分:1)

WorksheetFunction.Rank(y(R, C), r_values, 1)

您无法在arg1上放置数组。只是做:

i = y(R, C)

然后:

WorksheetFunction.Rank(i, r_values, 1)

它对我来说很好

答案 1 :(得分:0)

从评论中更新,因为我看到我最初提出的答案误解了问题:

作为一般规则,数组和纯粹在内存中执行计算的速度比您想象的要快。举一个例子,我曾经使用Application.Match函数来查找数组中值的索引位置,而不是简单的强力迭代。事实证明,迭代速度要快得多(速度提高了10倍!!!)。查看Tim对我关于Matching values in a string array的问题的回答。

我怀疑排名/排序是一样的。工作表功能很昂贵。相对来说,For/Next不是。

至于从数组中排名的具体需求,有一些自定义函数的例子,它们对数组,集合,字典等进行排序和排序。我最终使用了一堆Chip Pearson's Array helper functions,他有一个数字他们做什么真的很酷sh!t 像反转一个数组,排序数组,确定是否分配了一个数组(我使用这个 lot )或空,或所有数字,其中大约有30个。

here is the code to sort an array

注意:我没有发布他的代码,因为它有很多。虽然它看起来令人生畏,因为重新发明轮子需要很多代码,但它确实有效并且省去了很多麻烦并且非常有用。我甚至没有在Excel中使用这些,因为我现在在PowerPoint中完成了大部分的开发 - 我认为所有这些模块都在我的端部调试零或几乎为零。他们真的很好地搞定了。

获得排名

一旦数组被“排序”,那么确定其中任何值的等级都是微不足道的,只需要进行一些调整,因为您可能需要适当地处理关系。处理关系的一种常见方式是“跳过”下一个值,因此如果第二个位置存在双向关系,则排名将为{1,2,2,4,5,6等}} < / p>

Function GetRank(arr As Variant, val As Variant)
'Assumes arr is already sorted ascending and is a one-dimensional array
Dim rank As Long, i As Long
Dim dictRank As Object
Set dictRank = CreateObject("Scripting.Dictionary")
rank = 0
For i = LBound(arr) To UBound(arr)
    rank = rank + 1
    If dictRank.Exists(arr(i)) Then
        'Do nothing, handles ties

    Else
        'store the Key as your value, and the Value as the rank position:
        dictRank(arr(i)) = rank
    End If
    If arr(i) = val Then Exit For
Next

GetRank = rank
End Function