加权中位数 - 数组的 UDF？

Question

在 VBA 以及许多其他 excel/code/etc 方面，我是公认的新手。我四处寻找一种方法来计算中位数时的出现权重（一列用于值出现，一次用于值），我发现了一个运行良好的旧 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

我试过了 {=加权中位数(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:$C=$D2,$B:$B),IF($C:$C=$D2,$A:$A))}

正如评论中提到的，数组上下文中的 {IF($C:$C=$D2,$B:$B)} 和另一个 IF 将 而不是 导致范围，而是数组。所以 Function 必须按原样处理它们而不是范围。

请注意，作为 {IF($C:$C=$D2,$A:$A)} 结果的 Weights 数组是一个二维数组。 Values 作为 {IF($C:$C=$D2,$B:$B)} 的结果也是。但由于 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

转到工具 => 选项.. 并勾选 "Require Variable Declaration" 以自动将 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

加权中位数 - 数组的 UDF？

Weighted Median - UDF for array?

arrays

excel

vba

excel-formula

median

无需数组公式：

结果