Question

我尝试比较两列，并获得其他地方列出的不匹配结果。

到目前为止，我已经提出了以下建议：

Sub match_columns()
Dim i, Lastrow1, Lastrow3 As Integer
Dim found As Range

With Worksheets("sht1")

Lastrow1 = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lastrow1

answer1 = .Range("A" & i).Value
Set found = Sheets("sht2").Columns("A:A").Find(what:=answer1)

    If found Is Nothing Then
        Set rngNM = .Range("A" & i.Row)
    Else
        Set rngNM = Union(rngNM, .Range("A" & i.Row))
    End If
Next i


End With

    If Not rngNM Is Nothing Then rngNM.Copy Worksheets("sht3").[A2]

    Worksheets("sht3").[A1] = "title"

    Lastrow3 = Sheets("sht3").Range("A" & Rows.Count).End(xlUp).Row

    Sheets("sht3").Range("A2:A" & Lastrow3).Copy



End Sub

我目前收到以下内容的“运行时错误424；需要对象”：设置rngNM = .Range（“ A”＆i.Row）

我的代码在哪里？

Answer 1

尝试此代码

Sub Compare_Two_Columns()
    Dim ws As Worksheet, sh As Worksheet, out As Worksheet, c As Range, i As Long, m As Long, k As Long

    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        Set sh = ThisWorkbook.Worksheets("Sheet2")
        Set out = ThisWorkbook.Worksheets("Sheet3")
        m = ws.Range("A" & Rows.Count).End(xlUp).Row
        ReDim a(1 To m)

        For i = 1 To m
            Set c = sh.Range("A:A").Find(What:=ws.Cells(i, 1).Value, LookAt:=xlWhole)
            If c Is Nothing Then k = k + 1: a(k) = ws.Cells(i, 1).Value
        Next I

        If k > 0 Then
            With out
                .Range("A1").Value = "Title"
                .Range("A2").Resize(k).Value = Application.Transpose(a)
            End With
        End If
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

Excel VBA比较两列并列出不匹配的结果

1 个答案: