2列的快速比较方法[关闭]

EDIT:对于我的解决方案，请使用类似的东西

 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 循环来迭代第一 (src) 列，并使用 CountIf 方法来检查该项目是否已存在于第二 (des) 列中。如果没有，请复制到第一 (src) 列的末尾。

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

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

好的。让我们澄清一些事情。

所以专栏A has 10,000随机生成的值，列I has 5000随机生成的值。看起来像这样

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

the 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

席德的方法

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

我的（不知怎的）方法

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