計算在同一列同一文本值的標準差

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 

這將是很好，如果有人可以請給我一個想法或解決方案。以上代碼用於計算相同文本值的總和。有沒有辦法修改我的代碼來計算標準偏差？

Answer 1

這裏有一個公式，VBA路線，讓你的STDEV.S每個組項目。

圖片顯示了各種範圍和結果。我的輸入與你的輸入相同，但是我意外地將它排序在一個點上，所以他們不排隊。

的一些注意事項

• ARRAY是你想要的答案實際。稍後顯示NON-ARRAY。
• 我包括數據透視表來測試方法的準確性。
• VBA與計算爲UDF的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 

Answer 2

我走向不同的方向，並提供了一個僞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（<條件區域>，<標準>，< stdev.s值>）

在你的樣品，在C2中的公式將是，

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

填充根據需要放下。