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

Question

我正在尝试编写一个Excel宏，以计算列A中相同文本的标准偏差，将来自列B的值引入并在列C中给出结果:

我手动输入了公式=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

希望有人能给我一个想法或解决方案。上述代码是用于计算相同文本值的总和。是否有办法修改我的代码以计算标准偏差？

- Md. Abdur Rahim

---

亲爱的，你能再检查一下我的问题吗？因为我刚才更新了我的问题并添加了一段代码。@pnuts - Md. Abdur Rahim

a) 你是不是想说“=STDEV.S(B2; B3; B4; B16)”而不是“aaa”？ b) 列C的公式可行吗，还是必须要用宏？ - user4039065

那么 bbb、ccc 和 www 呢？它们的集合中只有三个值，而不像其他的集合有四个值。 - user4039065

如果宏对解决方案不是必需的，那么创建一个数据透视表，并根据数据透视表使用INDEX MATCH公式填充C列如何？ - Clif

很抱歉，对于这个计算，我需要宏，但如果您有更好的解决方案，请继续。@clif - Md. Abdur Rahim

@pnuts，我会认真对待我的错误 :-) - Clif

Answer 1

我采用了不同的方法，提供了一个伪STDEV.S.IF函数，可以像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（<条件范围>，<条件>，<标准偏差.s值>）

在您的示例中，C2 中的公式将是：

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

如有必要，请填写下降。

    

- user4039065

---

不要忘记将逗号替换为您系统区域设置使用的分号分隔符。 - user4039065

那是一件美妙的事情。+1 绝对没错。 - Clif

@pnuts - 你能在你的分号系统上试试这个吗？我认为VBA应该在Evaluate语句中保留逗号，但工作表语法应该是分号。（现在没时间翻转计算机的区域设置） - user4039065

@pnuts，好的，谢谢！我以为你在分号上。我想我要么暂时破坏我的系统，要么等待从OP那里听到成功/失败的消息。 - user4039065

谢谢您的合作。但是我有点困惑您的回答，因为您写了一个函数和一个公式。如果您能更详细地解释一下这个函数，那就太好了。@jeeped - Md. Abdur Rahim

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 如何知道以这种方式处理它。先前有一个 关于如何使用 Evaluate 处理数组公式并确定输出的相当详细的转换。这与那次谈话有些相关。

为了完整起见，这里是对 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

- Byron Wall

---

看起来很不错。如果我没记错，.Evaluate 总是会处理数组公式，无论是否需要。我相信用于定义条件格式规则的公式也是如此。甚至用于定义命名范围应用程序的那些公式也是如此。 - user4039065

@Jeeped，有趣。我可能会更深入地了解一下。验证这是一个可靠的执行数组公式的方法将是很好的。当然，“可靠”并不意味着“好的方法”。 - Byron Wall