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

Question

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

我手动输入了等式< code>=STDEV。s(A2；a3；a4；A16)表示“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

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

图片显示了各种范围和结果。我的输入与您的输入相同，但我意外地在某一点对其进行了排序，因此它们没有对齐。

一些注意事项

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

单元格 D3 中的公式是使用 CTRL 移位回车键输入的数组公式。同样的公式在 E3 中没有数组条目。两者都已复制到数据的末尾。

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

因为您似乎需要一个VBA版本，所以您可以在VBA中使用相同的公式，并将其包装在＜code＞应用程序中。评估

VBA代码使用“评估”来处理根据作为输入给出的范围生成的公式字符串。

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)

值得注意的是， .计算会将其作为数组公式正确处理。您可以将其与输出中包含的非阵列列进行比较。我不确定Excel如何知道以这种方式对待它。以前有一个相当扩展的转换，关于如何计算过程数组公式并确定输出。这与那次谈话密切相关。

为了完整起见，这里是对Sub方面的测试。我在一个模块中运行此代码，而Sheet2以外的工作表处于活动状态。这强调了使用Sheets（"Sheets2"）的能力。评估多工作表工作簿的，因为我的Range调用在技术上不合格。html" target="_blank">控制台输出包括在内。

Sub test()

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

End Sub

Answer 2

我走了另一个方向，提供了一个伪-＜code＞STDEV.S.IF＜/code＞来使用，非常类似于COUNTIF或AVERAGEIF函数。

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)

根据需要填写。