Excel VBA Countifs 与循环

Question

我是 VBA 新手。

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

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

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

谢谢

Answer 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

Answer 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