计算同一列中相同文本值的标准差

Question

我正在尝试在 Excel 中编写一个宏来计算 A 列中相同文本的标准偏差，从 B 列中获取值并在 C 列中给出结果：

我通过将 equation=STDEV.S(A2;A3;A4;A16)for "aaa" 手动完成。但我需要自动执行此操作，因为我正在执行另一个由宏完成的计算和程序。这是我的代码：

Option Explicit
Sub Main()
    CollectArray "A", "D"
    DoSum "D", "E", "A", "B"
End Sub


' collect array from a specific column and print it to a new one without duplicates
' params:
'           fromColumn - this is the column you need to remove duplicates from
'           toColumn - this will reprint the array without the duplicates
Sub CollectArray(fromColumn As String, toColumn As String)

    ReDim arr(0) As String

    Dim i As Long
    For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row
        arr(UBound(arr)) = Range(fromColumn & i)
        ReDim Preserve arr(UBound(arr) + 1)
    Next i
    ReDim Preserve arr(UBound(arr) - 1)
    RemoveDuplicate arr
    Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents
    For i = LBound(arr) To UBound(arr)
        Range(toColumn & i + 1) = arr(i)
    Next i
End Sub


' sums up values from one column against the other column
' params:
'           fromColumn - this is the column with string to match against
'           toColumn - this is where the SUM will be printed to
'           originalColumn - this is the original column including duplicate
'           valueColumn - this is the column with the values to sum
Private Sub DoSum(fromColumn As String, toColumn As String, originalColumn As String, valueColumn As String)
    Range(toColumn & "1:" & toColumn & Range(toColumn & Rows.Count).End(xlUp).Row).ClearContents
    Dim i As Long
    For i = 1 To Range(fromColumn & Rows.Count).End(xlUp).Row
        Range(toColumn & i) = WorksheetFunction.SumIf(Range(originalColumn & ":" & originalColumn), Range(fromColumn & i), Range(valueColumn & ":" & valueColumn))
    Next i
End Sub


Private Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
    If (Not StringArray) = True Then Exit Sub
    lowBound = LBound(StringArray): UpBound = UBound(StringArray)
    ReDim tempArray(lowBound To UpBound)
    cur = lowBound: tempArray(cur) = StringArray(lowBound)
    For A = lowBound + 1 To UpBound
        For B = lowBound To cur
            If LenB(tempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B
        tempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray
End Sub

如果有人能给我一个想法或解决方案，那就太好了。上面的代码用于计算相同文本值的总和。有没有办法修改我的代码来计算标准偏差？

Answer 1

我换了个方向，提供了一个伪STDEV.S.IF，就像COUNTIF 或AVERAGEIF function 一样使用。

Function STDEV_S_IF(rAs As Range, rA As Range, rBs As Range)
    Dim a As Long, sFRM As String

    sFRM = "STDEV.s("
    Set rBs = rBs(1).Resize(rAs.Rows.Count, 1)
    For a = 1 To rAs.Rows.Count
        If rAs(a).Value2 = rA.Value2 Then
            sFRM = sFRM & rBs(a).Value2 & Chr(44)
        End If
    Next a

    sFRM = Left(sFRM, Len(sFRM) - 1) & Chr(41)
    STDEV_S_IF = Application.Evaluate(sFRM)
End Function

语法：STDEV_S_IF(, , )

在您的示例中，C2 中的公式为，

=STDEV_S_IF(A$2:A$20, A2, B$2:B$20)

根据需要填写。

    

Answer 2

这是一个公式和 VBA 路由，可为您提供每组项目的 STDEV.S。

图片显示了各种范围和结果。我的输入和你的一样，但是我不小心把它排序了，所以它们没有排成一行。

一些笔记

• ARRAY 是您想要的实际答案。 NON-ARRAY 稍后显示。
• 我包含了数据透视表来测试该方法的准确性。
• VBA 与 ARRAY 的答案相同，计算为 UDF，可以在 VBA 的其他地方使用。

单元格D3 中的

公式 是使用 CTRL+SHIFT+ENTER 输入的数组公式。相同的公式在 E3 中没有数组条目。两者都已被复制到数据的末尾。

=STDEV.S(IF(B3=$B$3:$B$21,$C$3:$C$21))

由于您似乎需要此版本的 VBA 版本，您可以在 VBA 中使用相同的公式并将其包装在 Application.Evaluate 中。这几乎就是@Jeeped 获得答案的方式，将范围转换为符合条件的值。

VBA 代码 使用Evaluate 处理从作为输入的给定范围构建的公式字符串。

Public Function STDEV_S_IF(rng_criteria As Range, rng_criterion As Range, rng_values As Range) As Variant

    Dim str_frm As String

    'formula to reproduce
    '=STDEV.S(IF(B3=$B$3:$B$21,$C$3:$C$21))

    str_frm = "STDEV.S(IF(" & _
        rng_criterion.Address & "=" & _
        rng_criteria.Address & "," & _
        rng_values.Address & "))"

    'if you have more than one sheet, be sure it evalutes in the right context
    'or add the sheet name to the references above
    'single sheet works fine with just Application.Evaluate

    'STDEV_S_IF = Application.Evaluate(str_frm)
    STDEV_S_IF = Sheets("Sheet2").Evaluate(str_frm)

End Function

F3中的公式是同上公式的VBA UDF，作为普通公式输入（虽然作为数组输入不影响任何内容）并向下复制到最后。

=STDEV_S_IF($B$3:$B$21,B3,$C$3:$C$21)

值得注意的是，.Evaluate 将其正确地处理为数组公式。您可以将此与输出中包含的NON-ARRAY 列进行比较。我不确定 Excel 如何知道以这种方式对待它。以前有a fairly extended conversion about how Evaluate process array formulas and determines the output。这与那次谈话无关。

为了完整起见，这里是对 Sub 方面的测试。我在一个模块中运行此代码，其中的工作表不是Sheet2 处于活动状态。这强调了将Sheets("Sheets2").Evaluate 用于多表工作簿的能力，因为我的Range 调用在技术上是不合格的。包括控制台输出。

Sub test()

    Debug.Print STDEV_S_IF(Range("B3:B21"), Range("B3"), Range("C3:C21"))
    'correctly returns  206.301357242263

End Sub