excel VBA的逻辑冗余

Question

请参阅附图 -

我的要求是 -

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

  

检查value2。如果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，或
  • 此status = selected
  没有Ref no

我会针对数据打开一个ADODB Recordset，使用以下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，您需要

使用Ref no子句

按GROUP BY分组记录

的平均值

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

• value2如果存在，否则为value1

Iif(value2 IS NOT NULL, value2, value1)

• 其中status为selected或

WHERE Sheet1.status="selected" OR

• 此status = selected
没有Ref no

我们获得了DISTINCT的{​​unique Ref no} 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