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

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

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

 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 

如果有人能给我一个想法或解决scheme，这将是很好的。 上面的代码是用于计算相同文本值的总和。 有没有办法修改我的代码来计算标准偏差？

Answer 1

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

图片显示了各种范围和结果。 我的意见和你的意见是一样的，但是我不小心把它排在一个地方，所以他们没有排队。

一些笔记

• ARRAY是你想要的实际答案。 以后会显示无数据。
• 我包括数据透视表来testing方法的准确性。
• VBA与ARRAY计算的UDF是相同的，可以在VBA的其他地方使用。

单元格D3中的公式是使用CTRL + SHIFT + ENTERinput的数组公式。 没有数组input的E3相同的公式。 两者都被复制到数据的末尾。

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

既然看起来你需要这个VBA版本，你可以在VBA中使用相同的公式，并把它包装在Application.Evaluate 。 这几乎是@Jeeped如何得到一个答案，将范围转换为符合条件的值。

VBA代码使用Evaluate来处理从input给定范围构build的公式string。

 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，它作为正常公式input（尽pipe作为数组input不会影响任何内容）并被复制到最后。

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

值得注意的是.Evaluate正确处理这个数组公式。 您可以将其与输出中包含的NON-ARRAY列进行比较。 我不确定Excel如何知道这样对待它。 以前有一个相当广泛的转换关于如何Evaluate过程数组公式并确定输出 。 这与谈话切线相关。

为了完整性，这里是对事物的Sub方面的考验。 我在一个模块中运行代码而不是活动的Sheet2 。 这强调了使用Sheets("Sheets2").Evaluate由于我的Range调用在技术上是不合格的，因此对多页工作簿进行Sheets("Sheets2").Evaluate 。 控制台输出包括在内。

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

Answer 2

我走了一个不同的方向，提供了一个伪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（ <criteria range>，<criteria>，<stdev.s values> ）

在你的样本中，C2中的公式是，

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

根据需要填写。