计算同一列中相同文本值的标准偏差
Calculate standard deviation of same text values in same column
我正在尝试在 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
如果有人能给我一个想法或解决方案，那就太好了。上面的代码用于计算相同文本值的总和。有什么办法可以修改我的代码来计算标准差吗？
我转向了不同的方向并提供了一个伪 STDEV.S.IF 可以像 COUNTIF or 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
Syntax: STDEV_S_IF(<criteria range>, <criteria>, <stdev.s values>)
在您的示例中，C2 中的公式为，
=STDEV_S_IF(A:A, A2, B:B)
根据需要填写。
这是一个公式和 VBA 路线，可为您提供每组项目的 STDEV.S。
图片显示了各种范围和结果。我的输入和你的一样，但是我不小心把它放在了一个位置，所以它们没有排成一行。
一些笔记
ARRAY 是您想要的实际答案。 NON-ARRAY 稍后显示。- 我加入了数据透视表来测试该方法的准确性。
VBA 与计算为 UDF 的 ARRAY 的答案相同，可以在 VBA.
公式在单元格D3中是用CTRL+SHIFT+ENTER输入的数组公式。 E3 中的相同公式没有数组条目。两者都已复制到数据末尾。
=STDEV.S(IF(B3=$B:$B,$C:$C))
由于您似乎需要此的 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:$B,$C:$C))
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:$B,B3,$C:$C)
值得注意的是，.Evaluate 将其作为数组公式正确处理。您可以将其与输出中包含的 NON-ARRAY 列进行比较。我不确定 Excel 怎么知道要这样对待它。之前有a fairly extended conversion about how Evaluate process array formulas and determines the output。这与那次谈话无关。
为了完整起见，这里是对 Sub 方面的测试。我 运行 这个代码在一个 sheet 而非 Sheet2 活跃的模块中。这强调了将 Sheets("Sheets2").Evaluate 用于多 sheet 工作簿的能力，因为我的 Range 调用在技术上不合格。包括控制台输出。
Sub test()
Debug.Print STDEV_S_IF(Range("B3:B21"), Range("B3"), Range("C3:C21"))
'correctly returns 206.301357242263
End Sub
我正在尝试在 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
如果有人能给我一个想法或解决方案，那就太好了。上面的代码用于计算相同文本值的总和。有什么办法可以修改我的代码来计算标准差吗？
我转向了不同的方向并提供了一个伪 STDEV.S.IF 可以像 COUNTIF or 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
Syntax: STDEV_S_IF(<criteria range>, <criteria>, <stdev.s values>)
在您的示例中，C2 中的公式为，
=STDEV_S_IF(A:A, A2, B:B)
根据需要填写。
这是一个公式和 VBA 路线，可为您提供每组项目的 STDEV.S。
图片显示了各种范围和结果。我的输入和你的一样，但是我不小心把它放在了一个位置，所以它们没有排成一行。
一些笔记
ARRAY是您想要的实际答案。NON-ARRAY稍后显示。- 我加入了数据透视表来测试该方法的准确性。
VBA与计算为 UDF 的ARRAY的答案相同，可以在 VBA. 的其他地方使用
公式在单元格D3中是用CTRL+SHIFT+ENTER输入的数组公式。 E3 中的相同公式没有数组条目。两者都已复制到数据末尾。
=STDEV.S(IF(B3=$B:$B,$C:$C))
由于您似乎需要此的 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:$B,$C:$C))
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:$B,B3,$C:$C)
值得注意的是，.Evaluate 将其作为数组公式正确处理。您可以将其与输出中包含的 NON-ARRAY 列进行比较。我不确定 Excel 怎么知道要这样对待它。之前有a fairly extended conversion about how Evaluate process array formulas and determines the output。这与那次谈话无关。
为了完整起见，这里是对 Sub 方面的测试。我 运行 这个代码在一个 sheet 而非 Sheet2 活跃的模块中。这强调了将 Sheets("Sheets2").Evaluate 用于多 sheet 工作簿的能力，因为我的 Range 调用在技术上不合格。包括控制台输出。
Sub test()
Debug.Print STDEV_S_IF(Range("B3:B21"), Range("B3"), Range("C3:C21"))
'correctly returns 206.301357242263
End Sub