加权中位数 - 数组的UDF？

Question

当谈到在VBA和excel / code /等许多其他东西中玩游戏时，我是一个新手。在计算中位数时，我试图找到一种方法来计算出现加权（一个值出现一列，一次出现值），我找到了一个效果很好的旧UDF。

现在我可能会变得有点贪心，但我正在尝试处理相当多的信息，而最快的方法是仅在第三列中的标签标识值时才使用WeightedMedian。

Occurr. Cost    Store Name
1   9.99    Charlie
4   15  Charlie
5   8   Charlie
6   10  Romeo
9   12  Delta
2   15  Romeo
3   8   Romeo
4   9.99    Delta
6   15  Delta
1   8   Delta

我试过这个 {= WeightedMedian（IF（$ C $ 2：$ C $ 12 = $ D2，$ B $ 2：$ B $ 12），IF（$ C $ 2：$ C $ 12 = $ D2，$ A $ 2：$ A $ 12） ）} 希望返回两个必要的数组来服务WeightedMedian的ValueRange和WeightRange。但是我只是得到#Value错误。有关如何解决它的任何想法？下面列出的原始UDF。

*UDF*

Function WeightedMedian(ValueRange As Range, WeightRange As Range)

Dim MedianArray()

On Error GoTo WrongRanges

ArrayLength = Application.Sum(WeightRange)
ReDim MedianArray(1 To ArrayLength)

Counter = 0
ArrayCounter = 0

For Each ValueRangeCell In ValueRange

LoopCounter = LoopCounter + 1
FirstArrayPos = ArrayCounter + 1
ArrayCounter = ArrayCounter + Application.Index(WeightRange, LoopCounter)

For n = FirstArrayPos To ArrayCounter

MedianArray(n) = ValueRangeCell.Value

Next

Next
WeightedMedian = Application.Median(MedianArray)
Exit Function

WrongRanges:
WeightedMedian = CVErr(2042)
End Function

Answer 1

我刚刚将您的功能更改为以下数组公式：

{=WeightedMedian(IF($C$2:$C$12=$D2,$B$2:$B$12),IF($C$2:$C$12=$D2,$A$2:$A$12))}

正如评论中提到的，{IF($C$2:$C$12=$D2,$B$2:$B$12)}和数组上下文中的另一个IF 不会导致范围但是在数组中。因此Function必须处理它们而不是范围。

注意，作为Weights的结果的{IF($C$2:$C$12=$D2,$A$2:$A$12)}数组是一个二维数组。 Values的结果{IF($C$2:$C$12=$D2,$B$2:$B$12)}也是。但由于For Each我们不需要注意它。

UDF：

Function WeightedMedian(Values As Variant, Weights As Variant) As Variant

 Dim MedianArray()

 On Error GoTo WrongRanges

 ArrayLength = Application.Sum(Weights)
 ReDim MedianArray(1 To ArrayLength)

 Counter = 0
 ArrayCounter = 0

 For Each sValue In Values

  LoopCounter = LoopCounter + 1
  FirstArrayPos = ArrayCounter + 1
  ArrayCounter = ArrayCounter + Weights(LoopCounter, 1)

  For n = FirstArrayPos To ArrayCounter

   MedianArray(n) = sValue

  Next

 Next

 WeightedMedian = Application.Median(MedianArray)
 Exit Function

WrongRanges:
 WeightedMedian = CVErr(2042)
End Function

结果：

Answer 2

转到工具=＆gt;选项..和勾选＆＃34;要求变量声明＆＃34;自动将Option Explicit添加到您将来创建的每个模块的顶部。你将永远感谢我。

不需要数组公式：

以下是另外两个参数，StoreRange和store。

函数将输入范围转换为它循环的变量数组。

可能比@AxelRichter回答慢，但不要求CSE进入。

Function WeightedMedianArrays(ValueRange As Range, _
    WeightRange As Range, _
    StoreRange As Range, _
    store As String) As Single
'Assumes all ranges start on same row and are same length
Dim MedianArray()
Dim Weights() As Variant
Dim Vals() As Variant
Dim Stores() As Variant
Dim FirstArrayPos As Long
Dim n As Long
Dim x As Long


    Weights = WeightRange
    Vals = ValueRange
    Stores = StoreRange
    For x = 1 To UBound(Vals)
        If Stores(x, 1) = store Then
            ReDim Preserve MedianArray(1 To FirstArrayPos + Weights(x, 1))
            For n = 1 To Weights(x, 1)
                MedianArray(FirstArrayPos + n) = Vals(x, 1)
            Next
            FirstArrayPos = FirstArrayPos + Weights(x, 1)
        End If
    Next
    WeightedMedianArrays = Application.Median(MedianArray)
End Function

结果