excel VBA的逻辑冗余

Question

请看附图——

我的要求是-

• “如果status null和Ref No. not unique那么

检查值2。如果 value2 不存在，检查 value1 并取平均值

示例：对于 ref number = 1，计算值为 (50+10)/2 = 30"

• "如果status is selected或Ref no is unique那么

从 value2 复制，如果不存在则从 value1 复制

示例：对于 Ref No 3，值为 100，对于 Ref No 4，值为 20

• 总值= 100+30+20 = 150

我的尝试

For I = 2 To lrow 'sheets all have headers that are 2 rows

        'unique
            If Application.WorksheetFunction.CountIf(ws.Range("A" & fRow, "A" & lrow), ws.Range("A" & I)) = 1 Then
                If (ws.Range("AW" & I) <> "") Then 'AW has value2
                    calc = calc + ws.Range("AW" & I).Value
                Else: calc = calc + ws.Range("AV" & I).Value 'AV has value1
                End If
        'not unique
            Else
                'selected
                If ws.Range("AY" & I) = "Selected" Then 'AY has status (Selected/Null)
                    If (ws.Range("AW" & I) <> "") Then
                        calc = calc + ws.Range("AW" & I).Value
                    Else: calc = calc + ws.Range("AV" & I).Value
                    End If
                'not selected
                Else
                    If (ws.Range("AW" & I) <> "") Then
                        calc1 = calc1 + ws.Range("AW" & I).Value
                    Else: calc1 = calc1 + ws.Range("AV" & I).Value
                    End If
                    calc1 = calc1/Application.WorksheetFunction.CountIf(ws.Range("A" & fRow, "A" & lrow), ws.Range("A" & I))
                End If
            End If

我的问题是——

• 在我的逻辑中两次获得 Ref No 3。
• 无法计算正确的平均值。

我怎样才能得到正确的输出？谢谢。

Answer 1

对工作表使用 SQL 语句

如果我理解您的要求，他们如下：

• 对于每个Ref no，你想要
• 平均
  • value2 如果存在，否则 value1
• 其中status 是selected，或
  • 这个Ref no没有status = selected

我会针对数据打开一个 ADODB 记录集，使用以下 SQL：

SELECT [Ref no], Avg(Iif(value2 IS NOT NULL, value2, value1)) AS Result
FROM Sheet1
LEFT JOIN (
    SELECT DISTINCT [Ref No]
    FROM Sheet1
    WHERE status = "selected"
) t1 ON Sheet1.[Ref no] = t1.[Ref no]
WHERE Sheet1.status="selected" OR t1.[Ref no] IS NULL
GROUP BY [Ref no]

---

使用嵌套Scripting.Dictionary

如果 SQL 不是你的菜，那么你可以像下面这样：

'Define names for the columns; much easier to read row(RefNo) then arr(0)
Const refNo = 1
Const status = 3
Const value1 = 5
Const value2 = 6

'For each RefNo, we have to store 3 pieces of information:
'   whether any of the rows are selected
'   the sum of the values
'   the count of the values
Dim aggregates As New Scripting.Dictionary

Dim arr() As Variant
arr = Sheet1.UsedRange.Value

Dim maxRow As Long
maxRow = UBound(arr, 1)

Dim i As Long
For i = 2 To maxRow 'exclude the column headers in the first row
    Dim row() As Variant
    row = GetRow(arr, i)

    'Get the current value of the row
    Dim currentValue As Integer
    currentValue = row(value1)
    If row(value2) <> Empty Then currentValue = row(value2)

    'Ensures the dictionary always has a record corresponding to the RefNo
    If Not aggregates.Exists(row(refNo)) Then Set aggregates(row(refNo)) = InitDictionary

    Dim hasPreviousSelected As Boolean
    hasPreviousSelected = aggregates(row(refNo))("selected")

    If row(status) = "selected" Then
        If Not hasPreviousSelected Then
            'throw away any previous sum and count; they are from unselected rows
            Set aggregates(row(refNo)) = InitDictionary(True)
        End If
    End If

    'only include currently seleced refNos, or refNos which weren't previously selected,
    If row(status) = "selected" Or Not hasPreviousSelected Then
        aggregates(row(refNo))("sum") = aggregates(row(refNo))("sum") + currentValue
        aggregates(row(refNo))("count") = aggregates(row(refNo))("count") + 1
    End If
Next

Dim key As Variant
For Each key In aggregates
    Debug.Print key, aggregates(key)("sum") / aggregates(key)("count")
Next

具有以下两个辅助函数：

Function GetRow(arr() As Variant, rowIndex As Long) As Variant()
    Dim ret() As Variant
    Dim lowerbound As Long, upperbound As Long
    lowerbound = LBound(arr, 2)
    upperbound = UBound(arr, 2)
    ReDim ret(1 To UBound(arr, 2))
    Dim i As Long
    For i = lowerbound To upperbound
        ret(i) = arr(rowIndex, i)
    Next
    GetRow = ret
End Function

Function InitDictionary(Optional selected As Boolean = False) As Scripting.Dictionary
    Set InitDictionary = New Scripting.Dictionary
    InitDictionary.Add "selected", selected
    InitDictionary.Add "sum", 0
    InitDictionary.Add "count", 0
End Function

---

SQL解释

• 对于每个Ref no，你想要

使用GROUP BY 子句按Ref no 对记录进行分组

• 平均

我们将同时返回 Ref no 和 average -- SELECT [Ref no], Avg(...)

• value2如果存在，否则value1

Iif(value2 IS NOT NULL, value2, value1)

• 其中status 是selected，或者

WHERE Sheet1.status="selected" OR

• 这个Ref no没有status = selected

我们得到一个列表（唯一的 -- DISTINCT）Ref nos 有status = "selected"：

SELECT DISTINCT [Ref No]
FROM Sheet1
WHERE status = "selected"

并为其命名 (AS t1)，以便我们可以将其与主列表分开引用 (Sheet1)

然后我们将该子列表连接或加入 (JOIN) 到主列表，其中 [Ref no] 在两者中相同 (ON Sheet1.[Ref no] = t1.[Ref no])。

一个简单的JOIN 是一个INNER JOIN，连接两边的记录必须匹配。在这种情况下，我们想要的是主列表中与子列表中的记录不匹配的记录。为了查看这样的记录，我们可以使用LEFT JOIN，它显示左侧的所有记录，并且仅显示右侧匹配的那些记录。

然后我们可以过滤掉匹配的记录，使用OR t1.[Ref no] IS NULL。

Answer 2

必须有一种更简洁的方式，但我认为这可以满足您的需求。它基于您的示例，因此 A1:F6 中的数据需要修改。

Sub x()

Dim v2() As Variant, v1, i As Long, n As Long, d As Double

v1 = Sheet1.Range("A1:F6").Value
ReDim v2(1 To UBound(v1, 1), 1 To 5) 'ref/count/null/value null/value selected

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(v1, 1)
        If Not .Exists(v1(i, 1)) Then
            n = n + 1
            v2(n, 1) = v1(i, 1)
            v2(n, 2) = v2(n, 2) + 1
            If v1(i, 3) = "" Then
                v2(n, 3) = v2(n, 3) + 1
                v2(n, 4) = IIf(v1(i, 6) = "", v1(i, 5), v1(i, 6))
            ElseIf v1(i, 3) = "selected" Then
                v2(n, 5) = IIf(v1(i, 6) = "", v1(i, 5), v1(i, 6))
            End If
            .Add v1(i, 1), n
        ElseIf .Exists(v1(i, 1)) Then
            v2(.Item(v1(i, 1)), 2) = v2(.Item(v1(i, 1)), 2) + 1
            If v1(i, 3) = "" Then
                v2(.Item(v1(i, 1)), 3) = v2(.Item(v1(i, 1)), 3) + 1
                If v1(i, 6) = "" Then
                    v2(.Item(v1(i, 1)), 4) = v2(.Item(v1(i, 1)), 4) + v1(i, 5)
                Else
                    v2(.Item(v1(i, 1)), 4) = v2(.Item(v1(i, 1)), 4) + v1(i, 6)
                End If
            Else
                If v1(i, 6) = "" Then
                    v2(.Item(v1(i, 1)), 5) = v2(.Item(v1(i, 1)), 5) + v1(i, 5)
                Else
                    v2(.Item(v1(i, 1)), 5) = v2(.Item(v1(i, 1)), 5) + v1(i, 6)
                End If
            End If
        End If
    Next i
End With

For i = LBound(v2, 1) To UBound(v2, 1)
    If v2(i, 2) > 1 And v2(i, 3) = v2(i, 2) Then
        d = d + v2(i, 4) / v2(i, 2)
    End If
    If v2(i, 2) > 1 And v2(i, 3) < v2(i, 2) Then
        d = d + v2(i, 5) / (v2(i, 2) - v2(i, 3))
    End If
    If v2(i, 2) = 1 And v2(i, 3) = v2(i, 2) Then
        d = d + v2(i, 4) / v2(i, 2)
    End If
Next i

MsgBox "Total = " & d

End Sub