VBA Excel - если найден в списке, то пропустить

Question

Я пытаюсь написать скрипт, который сравнивает значения в одном списке со значениями в другом. Если значение не найдено в списке сравнения, я хотел бы скопировать всю строку с одного листа на другой.

Используя Application.VLookup / Application.WorksheetFunction.Vlookup, я получаю сообщение об ошибке 13/1004, потому что не найдено никакого значения. Я хотел бы отключить это значение не найдено, чтобы сделать копию.

Function Update()

Dim Master As Worksheet
Dim Slave As Worksheet
Dim lrM As Long
Dim lrS As Long
Dim i As Long, m, MLookup As Range
'Dim j As Long, n, SLookup As Range

Set Master = ThisWorkbook.Worksheets("PR Data Windchill")
Set Slave = ThisWorkbook.Worksheets("PR Data")

Set MLookup = ThisWorkbook.Worksheets("PR Data").Columns(1)
'Set SLookup = ThisWorkbook.Worksheets("PR Data Windchill").Columns(7)

lrM = Master.Cells(Master.Rows.Count, "A").End(xlUp).Row
lrS = Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Row

With Master
    For i = 2 To lrM
        m = Application.Match(.Rows(i).Cells(1).Value, MLookup, 0)
        If IsError(m) Then
            .Rows(i).Copy Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next i
End With

'With Slave
'    For j = 2 To lrS
'        n = Application.Match(.Rows(j).Cells(1).Value, SLookup, 0)
'        If IsError(n) Then
'            .Rows(j).Copy Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Offset(1, 0)
'        End If
'    Next j
'End With

Application.CutCopyMode = False

MsgBox ("Matrix Update Complete")

End Function

Answer 1

Это мое лучшее предположение (включая второй поиск):

Sub Update()

    Dim Master As Worksheet
    Dim Slave As Worksheet
    Dim lrM As Long
    Dim lrS As Long
    Dim i As Long, m, MLookup As Range, SLookup As Range

    Set Master = ThisWorkbook.Worksheets("PR Data Windchill")
    Set Slave = ThisWorkbook.Worksheets("PR Data")

    Set MLookup = Slave.Columns(1)  '<< reference list
    Set SLookup = Master.Columns(1) '<< reference list

    lrM = Master.Cells(Master.Rows.Count, "A").End(xlUp).Row
    lrS = Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Row

    With Master
        For i = 2 To lrM
            'drop the worksheetfunction to avoid a run-time error,
            '   and instead check the return value for an error
            m = Application.Match(.Rows(i).Cells(1).Value, MLookup, 0)
            If IsError(m) Then
                'no match, so copy over
                .Rows(i).Copy Slave.Cells(Slave.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next i
    End With

    With Slave
        For i = 2 To lrS
            m = Application.Match(.Rows(i).Cells(1).Value, SLookup, 0)
            If Not IsError(m) Then
                Master.Cells(m, 7).Copy S.Rows(i).Cells(1)
            End If
        Next j
    End With

    Application.CutCopyMode = False

    MsgBox "Matrix Update Complete"

End Function