如何评估依赖于类别组内统计量的条件

Question

首先，我将展示一个最小的数据示例和到目前为止我所拥有的代码，以便更容易解释我的问题。

考虑以下数据:

ID  Esp         DBH     Cod
55  E_grandis   9.00    
55  E_grandis   9.71    7
55  E_grandis   10.00   
55  E_grandis   1.00    7
55  E_grandis   7.00    7
55  E_grandis           1

我正在尝试验证是否行与Cod = 7的值大于:

 average of DBH - 1 * standard deviation of DBH.

在上例中，DBH的平均值为7.34，标准差为3.73。因此，当它们被标记为Cod 7时，dbh值不应大于3.61(7.34 - 3.73)。

细胞D3和D6不符合标准，因为它们的dbh (C3和C6)大于3.61。在Cod为7的所有行中，只有C5小于3.61。

我写了下面的代码，当不满足这些条件时显示一个消息框:

Sub Cod7()
Dim msg As String 'msg box
Dim ID As Range
Dim dbh_stdev As Double 'standard deviation of dbh
Dim dbh_avg As Double 'average of dbh
Dim not_dominated As Double 'criteria threshold (upper bound)
Dim cell_i As Range 'initial of array to compute average and standard deviation
Dim cell_e As Range 'end of array to compute average and standard deviation
    msg = ""
    Set cell_i = Range("C2")
    Set cell_e = Range("C7")
    dbh_stdev = WorksheetFunction.StDev(Range(cell_i, cell_e)) 'dbh standard deviation
    dbh_avg = WorksheetFunction.Average(Range(cell_i, cell_e)) 'dbh average
    not_dominated = dbh_avg - dbh_stdev 'upper bound
'searches cells with cod 7 on column Cod, and it displays a message box if
'DBH is greater than the 'not_dominated' variable value
For Each ID In Range("A2", Range("A2").End(xlDown))
    If ID.Offset(0, 3) = 7 And _
       ID.Offset(0, 2) <> 0 And _
       ID.Offset(0, 2) > not_dominated Then
             msg = msg & "Cod 7 on " & ID.Offset(0, 3).Address() & " is incorrect" & vbLf
    End If
Next ID
If Len(msg) > 0 Then MsgBox msg
End Sub

现在的问题是，在我的实际数据中，我在列Esp(物种)下有多个类别，我需要评估标准，计算每组物种内dbh的平均值和标准差。
物种群聚集在一起，即一个物种出现在相邻的行中。

例如，这是一个最小数据，在Esp列下有两个类别:E_grandis和E_citriodora。

ID  Esp           DBH    Cod
55  E_grandis     9.00  
55  E_grandis     9.71   7
55  E_grandis     10.00 
55  E_grandis     1.00   7
55  E_grandis     7.00   7
55  E_grandis            1
55  E_citriodora  3.00  
55  E_citriodora  2.00   7
55  E_citriodora  2.00   7
55  E_citriodora         1      
55  E_citriodora         1
55  E_citriodora  0.50   7

E_citriodora的平均胸径为1.88，标准差为1.03。Cod = 7的行DBH不能大于0.85(1.88-1.03)。在这种情况下，单元格C9和C10不通过标准，单元格C13通过。

我如何调整代码以在"Esp"组中应用这些标准?

Answer 1

我相信下面的代码可以满足您的要求。请注意，这只会在所有物种"分组"在一起时起作用。

我添加了一个外部循环，允许代码迭代所有具有数据的行(特别是具有ID值的行)。

起始单元格(cell_i)的初始值是C2，如在原始代码中，但我改变了它计算结束单元格(cell_e)的方式:它现在基于列B中具有与cell_i的当前物种相同的值的行数(这就是CountIf正在做的，这就是为什么这只有在所有物种聚集在一起时才有效)。

与Set cell_i = cell_e.Offset(1)一起，使循环从物种的第一行跳到下一行，等等。

例如，第一次对您的样本数据运行时，cell_i将是C2, cell_e将是C7，因为B列中具有E_grandis的行数是6，从cell_i的当前行减去1和偏移意味着它将选择从当前行向下5行的单元格。

第二次，它将从C8开始，经过C12。等。

在循环体中，我放置了原始代码(大部分"完好无损")。我刚刚调整了For循环，以便它迭代范围内的单元格(cell_i到cell_e，在groupRange变量中捕获)，而不是在列A中有值的所有行之间迭代。

我已经添加了几个Select调用，以便您可以在逐步执行代码时遵循ccell和groupRange的值。

Option Explicit
Public Sub Cod7()
    Dim msg As String 'msg box
    Dim dbh_stdev As Double 'standard deviation of dbh
    Dim dbh_avg As Double 'average of dbh
    Dim not_dominated As Double 'criteria threshold (upper bound)
    Dim cell_i As Range 'initial of array to compute average and standard deviation
    Dim cell_e As Range 'end of array to compute average and standard deviation
    Dim ccell As Range 'current cell
    Dim groupRange As Range
    msg = ""
    Set cell_i = Range("C2")
    Do While cell_i.Offset(, -2) <> ""
        Set cell_e = cell_i.Offset(WorksheetFunction.CountIf(Range("B:B"), cell_i.Offset(, -1).Value) - 1)
        Set groupRange = Range(cell_i, cell_e)
        groupRange.Select
        dbh_stdev = WorksheetFunction.StDev(groupRange) 'dbh standard deviation
        dbh_avg = WorksheetFunction.Average(groupRange) 'dbh average
        not_dominated = dbh_avg - dbh_stdev 'upper bound
        'searches cells with cod 7 on column Cod, and it displays a message box if
        'DBH is greater than the 'not_dominated' variable value
        For Each ccell In groupRange
            ccell.Select
            If ccell.Offset(, 1).Value = 7 And _
                ccell.Value <> 0 And _
                ccell.Value > not_dominated Then
                     msg = msg & "Cod 7 on " & ccell.Offset(, 1).Address() & " is incorrect" & vbLf
            End If
        Next
        Set cell_i = cell_e.Offset(1)
    Loop
    If Len(msg) > 0 Then MsgBox msg
End Sub

Answer 2

或者您可以将整个脚本一起删除，并在单元格E2中使用此公式(然后复制，粘贴):

{=IF(AND(D2=7,C2>AVERAGEIF($B$2:$B$13,B2,$C$2:$C$13)-1* STDEV(IF($B$2:$B$13=B2,$C$2:$C$13))),"warning","")}

注意数组公式 -记得用ctrl-shift-enter

Answer 3

在你的情况下，我会写代码列出每个可能的ESP值。我会将每个数据点与此列表进行比较，并保持运行总数以开发平均DBH，再将DBH与列表进行比较以开发标准偏差，为列表上的每个ESP编制最小/最大可接受DBH，然后进行最后一次检查实际DBH与最小/最大DBH对于特定ESP值并应用编码程序。