比较2个工作表值并返回匹配项,并且不存在匹配值vba

时间:2018-07-30 02:25:29

标签: vba

我尝试过此代码,并返回“ match”值是工作发现。  但存在诸如错误返回“ no match”值的问题。 我认为还有其他问题做过任何修改吗? 谢谢!

Sub compareAndCopy()

    Dim lastRowE As Long
    Dim lastRowF As Long
    Dim lastRowM As Long
    Dim lastRowN As Long

    Dim foundTrue As Boolean

    ' stop screen from updating to speed things up
    Application.ScreenUpdating = False

    lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
    lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row
    lastRowN = Sheets("Sheet4").Cells(Sheets("Sheet4").Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRowE
        foundTrue = False
        For j = 1 To lastRowF

            If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
                lastRowM = lastRowM + 1
                Sheets("Sheet2").Rows(i).Copy Destination:= _
                           Sheets("Sheet3").Rows(lastRowM)
                foundTrue = True
                Exit For
    **else
        lastRowN = lastRowN + 1
                Sheets("Sheet2").Rows(i).Copy Destination:= _
                           Sheets("Sheet4").Rows(lastRowN)
                foundTrue = True
            End If**
        Next j
    Next i


    Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

使用Match()可能比嵌套循环快。

Sub compareAndCopy()

    Dim sht1 As Worksheet, sht2 As Worksheet
    Dim shtDest As Worksheet, i As Long

    Set sht1 = Sheets("Sheet1")
    Set sht2 = Sheets("Sheet2")

    Application.ScreenUpdating = False

    For i = 1 To sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

        Set shtDest = IIf(IsError(Application.Match(sht2.Cells(i, 1).Value, sht1.Columns("A"), 0)), _
                          Sheets("Sheet4"), Sheets("Sheet3"))

        sht2.Rows(i).Copy shtDest.Cells(shtDest.Rows.Count, "B").End(xlUp).Offset(1, -1)

    Next i

    Application.ScreenUpdating = True

End Sub