2列的快速比较方法

Question

编辑:而不是我的解决方案,使用类似的东西

 For i = 1 To tmpRngSrcMax
     If rngSrc(i) <> rngDes(i) Then ...
 Next i

它快了大约100倍.

我必须使用VBA比较包含字符串数据的两列.这是我的方法:

Set rngDes = wsDes.Range("A2:A" & wsDes.Cells(Rows.Count, 1).End(xlUp).Row)
Set rngSrc = wsSrc.Range("I3:I" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row)

tmpRngSrcMax = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
cntNewItems = 0

For Each x In rngSrc

tmpFound = Application.WorksheetFunction.CountIf(rngDes, x.Row)
Application.StatusBar = "Processed: " & x.Row & " of " & tmpRngSrcMax & " / " & Format(x.Row / tmpRngSrcMax, "Percent")
DoEvents ' keeps Excel away from the "Not responding" state

If tmpFound = 0 Then ' new item
    cntNewItems = cntNewItems + 1

    tmpLastRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row + 1  ' first empty row on target sheet
    wsDes.Cells(tmpLastRow, 1) = wsSrc.Cells(x.Row, 9)
End If
Next x

因此,我使用For Each循环通过1st(src)列进行迭代,并使用CountIf方法检查该项是否已存在于2nd(des)列中.如果没有,请复制到第1(src)列的末尾.

代码可以工作,但是在我的机器上,给定大约7000行的列需要大约200秒.我注意到,当直接用作公式时,CountIf的工作速度更快.

有没有人有代码优化的想法？

Answer 1

好.让我们澄清一些事情.

因此列A具有10,000随机生成的值,列I具有5000随机生成的值.看起来像这样

我针对10,000个单元格运行了3个不同的代码.

的for i = 1 to ... for j = 1 to ...方法,你所提出的建议之一

Sub ForLoop()

Application.ScreenUpdating = False

    Dim stNow As Date
    stNow = Now

    Dim lastA As Long
    lastA = Range("A" & Rows.Count).End(xlUp).Row

    Dim lastB As Long
    lastB = Range("I" & Rows.Count).End(xlUp).Row

    Dim match As Boolean

    Dim i As Long, j As Long
    Dim r1 As Range, r2 As Range
    For i = 2 To lastA
        Set r1 = Range("A" & i)
        match = False
        For j = 3 To lastB
            Set r2 = Range("I" & j)
            If r1 = r2 Then
                match = True
            End If
        Next j
        If Not match Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = r1
        End If
    Next i

    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

希德的appraoch

Sub Sample()
    Dim wsDes As Worksheet, wsSrc As Worksheet
    Dim rngDes As Range, rngSrc As Range
    Dim DesLRow As Long, SrcLRow As Long
    Dim i As Long, j As Long, n As Long
    Dim DesArray, SrcArray, TempAr() As String
    Dim boolFound As Boolean

    Set wsDes = ThisWorkbook.Sheets("Sheet1")
    Set wsSrc = ThisWorkbook.Sheets("Sheet2")

    DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row
    SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row

    Set rngDes = wsDes.Range("A2:A" & DesLRow)
    Set rngSrc = wsSrc.Range("I3:I" & SrcLRow)

    DesArray = rngDes.Value
    SrcArray = rngSrc.Value

    For i = LBound(SrcArray) To UBound(SrcArray)
        For j = LBound(DesArray) To UBound(DesArray)
            If SrcArray(i, 1) = DesArray(j, 1) Then
                boolFound = True
                Exit For
            End If
        Next j

        If boolFound = False Then
            ReDim Preserve TempAr(n)
            TempAr(n) = SrcArray(i, 1)
            n = n + 1
        Else
            boolFound = False
        End If
    Next i

    wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _
    Application.Transpose(TempAr)
End Sub

我的(mehow)方法

Sub Main()
Application.ScreenUpdating = False

    Dim stNow As Date
    stNow = Now

    Dim arr As Variant
    arr = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Value

    Dim varr As Variant
    varr = Range("I3:I" & Range("I" & Rows.Count).End(xlUp).Row).Value

    Dim x, y, match As Boolean
    For Each x In arr
        match = False
        For Each y In varr
            If x = y Then match = True
        Next y
        If Not match Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = x
        End If
    Next

    Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

结果如下

现在,你选择快速比较方法 :)

填写随机值

Sub FillRandom()
    Cells.ClearContents
    Range("A1") = "Column A"
    Range("I2") = "Column I"

    Dim i As Long
    For i = 2 To 10002
        Range("A" & i) = Int((10002 - 2 + 1) * Rnd + 2)
        If i < 5000 Then
            Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = _ 
                 Int((10002 - 2 + 1) * Rnd + 2)
        End If
    Next i

End Sub

Answer 2

这里是非循环代码,几乎可以立即执行上面给出的示例.

Sub HTH()

    Application.ScreenUpdating = False

    With Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 1)
        .Formula = "=VLOOKUP(A2,I:I,1,FALSE)"
        .Value = .Value
        .SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Range("I" & Rows.Count).End(xlUp).Offset(1)
        .ClearContents
    End With

    Application.ScreenUpdating = True

End Sub

您可以使用任何您喜欢的列作为虚拟列.

信息: 完成陷入循环

关于速度测试的一些注意事项:
在运行测试之前编译vba项目.
对于每个循环执行速度比对于i = 1到10循环更快.
如果找到答案,可以退出循环,以防止使用Exit For进行无意义循环.
Long执行得比整数快.

最后一个更快的循环方法(如果你必须循环,但它仍然没有上面的非循环方法那么快):

Sub Looping()
    Dim vLookup As Variant, vData As Variant, vOutput As Variant
    Dim x, y
    Dim nCount As Long
    Dim bMatch As Boolean

    Application.ScreenUpdating = False

    vData = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
    vLookup = Range("I2", Cells(Rows.Count, "I").End(xlUp)).Value

    ReDim vOutput(UBound(vData, 1), 0)

    For Each x In vData
        bMatch = False
        For Each y In vLookup
            If x = y Then
                bMatch = True: Exit For
            End If
        Next y
        If Not bMatch Then
            nCount = nCount + 1: vOutput(nCount, 0) = x
        End If
    Next x

    Range("I" & Rows.Count).End(xlUp).Offset(1).Resize(nCount).Value = vOutput

    Application.ScreenUpdating = True      

End Sub

根据@brettdj评论一个For Next替代方案:

For x = 1 To UBound(vData, 1)
    bMatch = False
    For y = 1 To UBound(vLookup, 1)
        If vData(x, 1) = vLookup(y, 1) Then
            bMatch = True: Exit For
        End If
    Next y
    If Not bMatch Then
        nCount = nCount + 1: vOutput(nCount, 0) = vData(x, 1)
    End If
Next x