VBA - Run WorksheetFunction on [Range derived] Var

2020-05-06 11:57发布

I have a need to run successive passes of built in excel functions on a single matrix of input.

The problem is, the input [range] is what I assume, a pointer constant.

So sure, I can do a WorkSheetFunction calculations on the [range] input and place the output into a variant.

But, I do have a need to run more passes on the variant data. I have a more advanced calculation that is going to run 4 transforms on data that use standard excel functions like average, and median.

Here's my code

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

The problem can be identified right around here:

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

2条回答
疯言疯语
2楼-- · 2020-05-06 12:26

Updated from comments as I see the answer I initially posited misread the problem:

As a general rule, arrays and performing calculations purely in memory are faster than you might think. For one example I used to use the Application.Match function to find the index position of a value in an array, rather than simple brute force iteration. Turns out that iteration was a far faster (up to 10x faster!!!) method. Check out Tim's answer to my question about Matching values in a string array.

I suspect it is the same with rank/sorting. Worksheet functions are expensive. For/Next is not, relatively speaking.

As for the specific needs to rank from an array, there are examples of custom functions which rank and sort arrays, collections, dictionaries, etc. I ultimately end up using a bunch of Chip Pearson's Array helper functions, he has a number of them; which do really cool sh!t like reversing an array, sorting array, determining whether an array is allocated (I use this one a lot) or empty, or all numeric, etc. There are about 30 of them.

here is the code to sort an array.

Note: I did not post his code because there is a lot of it. WHile it appears daunting, because it is a lot of code to re-invent the wheel, it does work and saves a lot of trouble and is very useful. I don't even use these in Excel, since I do most of my dev in PowerPoint now -- I think all of these modules ported over with zero or almost zero debugging on my end. They're really buttoned up quite nicely.

Getting the rank

Once the array is "sorted" then determining the rank of any value within it is trivial and only requires some tweaking since you may want to handle ties appropriately. One common way of dealing with ties is to "skip" the next value, so if there is a two-way tie for 2nd place, the rank would go {1, 2, 2, 4, 5, 6, etc.}

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
查看更多
啃猪蹄的小仙女
3楼-- · 2020-05-06 12:36
WorksheetFunction.Rank(y(R, C), r_values, 1)

You cannot put an Array on arg1. Just do:

i = y(R, C)

Then:

WorksheetFunction.Rank(i, r_values, 1)

It worked fine for me

查看更多
登录 后发表回答