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

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时,DBHs值不应大于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(specie)列下有多个类别,我需要评估标准,计算每组物种中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中DBH的平均值为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因为具有行数E_grandis列B是6,它减去1和偏移从cell_i的当前行装置,它会选择小区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