Excel VBA Countifs 与循环

Posted 2023-03-28

【中文标题】Excel VBA Countifs 与循环

【英文标题】：Excel VBA Countifs with Loops

【发布时间】：2021-12-16 07:52:03

【问题描述】：

我是 VBA 新手。

我在 Excel 中的每一行都有一个新列 (U) 中的这个公式，但耗时太长并且崩溃：

=IF(COUNTIFS($E:$E,E2,$A:$A,""&A2)>0,"是","否")

有没有办法在 VBA 中做到这一点？

谢谢

【问题讨论】：

甚至不知道问题所在：是的，如果可以在公式中完成，则可以在 VBA 中完成。除了明显的“是”。你能解释一下公式吗？对我来说，它看起来总是“不”。如果 E 是 E 而 A 不是 A，则“是”，否则“否”。但 A 总是 A，所以答案总是“否”。哦，但您正在其他地方搜索重复的 E，但 A 不同。

将范围大小限制为仅数据集。避免完整的列引用。否则请参阅：***.com/questions/64939776/faster-way-of-using-sumifs/…

【参考方案1】：

基于我对您的 Excel 公式的理解。您正在尝试在每行的 U 列中输入“是”，其中 E 列中的值在 E 列的其他位置可以找到，但前提是 A 列的值不同。

以下是您在 VBA 中的操作方式：

Sub Example()
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    
    Dim LastRow As Integer
    LastRow = Sh.Cells(Sh.Rows.Count, "E").End(xlUp).Row
    
    Dim TargetRange As Range
    Set TargetRange = Sh.Range("A2:E" & LastRow)
    
    Dim vArr() As Variant
    vArr = TargetRange.Value
    
    Dim ColU() As Variant
    ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
    
    Dim i As Long
    For i = 1 To UBound(vArr, 1)
            ColU(i, 1) = "No"
        Dim j As Long
        For j = 1 To UBound(vArr, 1)
            If vArr(i, 5) = vArr(j, 5) And vArr(i, 1) <> vArr(j, 1) Then
                ColU(i, 1) = "Yes"
                Exit For
            End If
        Next
    Next
    Sh.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub

我首先将范围A:E 的值放入一个数组中。然后我遍历数组检查我的陈述是否正确。如果为真，则为“是”，否则默认为“否”。然后我将答案输出到 U 列。

这种方法的缺点是它是 n^2 次迭代，因为我为数组的每一行循环遍历数组。对于非常大的数据集，它不可避免地会很慢。

@ChrisNeilsen 建议的一项改进是从i 开始内部循环，将迭代次数减少一半。为了融入这个想法，我首先在自己的循环中设置了 ColU 默认值，然后在找到重复项时，我可以同时将两个重复项设置为“是”。

Sub Example()
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    
    Dim LastRow As Integer
    LastRow = Sh.Cells(Sh.Rows.Count, "E").End(xlUp).Row
    
    Dim TargetRange As Range
    Set TargetRange = Sh.Range("A2:E" & LastRow)
    
    Dim vArr() As Variant
    vArr = TargetRange.Value
    
    Dim ColU() As Variant
    ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
    
    Dim i As Long
    For i = 1 To UBound(vArr, 1)
        ColU(i, 1) = "No"
    Next
    
    For i = 1 To UBound(vArr, 1)
        Dim j As Long
        For j = i To UBound(vArr, 1)
            If vArr(i, 5) = vArr(j, 5) And vArr(i, 1) <> vArr(j, 1) Then
                ColU(i, 1) = "Yes"
                ColU(j, 1) = "Yes"
                Exit For
            End If
        Next
    Next
    Sh.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub

【讨论】：

是的，感谢您的 VBA！它做我想做的事。不幸的是，您对非常大的数据集速度很慢也是正确的。有没有办法优化？从不同的文章中搜索建议删除“否”行。

几个小优化：更改为For f = I To ...并在ColU(i, 1) = ...之后添加Exit For

@chrisneilsen Exit For 是一个很好的建议，谢谢。我想我还会写第二个版本，可以利用你的For j = i To ... 建议

@toddleson 你可能对我刚刚发布的单循环替代方案感兴趣

【参考方案2】：

与双循环（按 n^2 顺序运行）不同，另一种使用单循环的方法是使用查找而不是内部循环（按 n 顺序运行，尽管每次迭代都稍微复杂一点)。

类似

Sub Example2()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row
    
    Dim TargetRange As Range
    Set TargetRange = ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, 5))
    
    Dim vArr() As Variant
    vArr = TargetRange.Value2
    
    Dim ColU() As Variant
    ReDim ColU(1 To UBound(vArr, 1), 1 To 1)
    
    Dim i As Long
    Dim j As Long
    Dim rE As Range
    Set rE = ws.Range(ws.Cells(2, 5), ws.Cells(LastRow, 5))
    
    ColU(UBound(vArr, 1), 1) = "No"
    For i = 1 To UBound(vArr, 1) - 1
        j = 0
        On Error Resume Next
            j = Application.WorksheetFunction.XMatch(vArr(i, 5), rE.Offset(i, 0), 0, 1)
        On Error GoTo 0
        ColU(i, 1) = "No"
        If j > 0 Then
            If vArr(i, 1) <> vArr(j + i, 1) Then
                ColU(i, 1) = "Yes"
                ColU(j + i, 1) = "Yes"
            End If
        End If
    Next
    ws.Range("U2").Resize(UBound(vArr, 1)).Value = ColU
End Sub

在我的硬件上，运行了一个任意样本数据集

Rows	double loop	this code
100	0.015	0.01
1000	0.17	0.03
10000	11.9	0.33
50000	285.0	2.0

【讨论】：

我不知道工作表匹配函数会比数组循环快得多。大进步！

需要注意的是，XMatch 是 Excel 365 中的新功能，因此此代码不适用于旧版本的 Excel。

@toddleson 我不为使用当前版本的 Excel 道歉。如果有人因使用旧版本而受到限制，则由他们自己说。无论如何，Match 也可以，只是速度没有那么快