Консолидация двух ошибок выполнения рабочих листов

Question

Я использую следующий код для объединения двух таблиц (Sheet 5 и Sheet 3). Точнее, я добавляю данные из Sheet 5 в Sheet 3, что работает гладко, если при обработке кода открылось Sheet 3. Однако, когда я переключаюсь на другой лист и запускаю код, код больше не работает должным образом.

1. Когда я запускаю код в первый раз, он работает гладко
2. Когда я запускаю код многократно, ничего не должно произойти, потому что мой макрос просто вставляет данные из Sheet 5 в Sheet 3, которых еще нет в Sheet 3, и, поскольку эти данные уже были вставлены в первый запуск, ничего не должно бывает. Это тот случай, когда я остаюсь на Sheet 3. Однако, если я переключаюсь на другой лист и запускаю код второй, третий, четвертый раз, то макрос выполняется частично каждый раз.

Позвольте мне объяснить это немного подробнее:

Для своих тестов я использую три строки с данными. Когда я выполняю кнопку в первый раз, все три строки в Sheet 5 добавляются к Sheet 3. Когда я нажимаю кнопку второй, третий, четвертый раз три строки добавляются к Sheet 3

• Первая добавленная строка: пусто

• Вторая и третья добавленная строка: содержат данные второй и третьей строки в Sheet 3

Кто-нибудь знает, что здесь происходит не так?

    Sub Consolidation()

    Dim lastrow As Long
    Dim NFR As Long


    lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
    NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
    Set myrange = Tabelle5.UsedRange


    For i = 4 To lastrow

    On Error Resume Next

    If Tabelle3.Cells(5 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(5 + i, 1), Tabelle5.Range("A:A"), False)) Then


        Tabelle3.Cells(5 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(5 + i, 1), myrange, 2, False)

    End If


    If IsError(Application.Match(Tabelle5.Cells(i, 1), Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row), False)) Then


        Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)


        Tabelle3.Cells(NFR + i, 2) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 2, False)


      End If

    Next i

    Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete



    End Sub

Answer 1

Примерно так (не проверено):

Sub Consolidation()

    Dim lastrow As Long
    Dim NFR As Long, r, v

    lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
    NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
    Set myrange = Tabelle5.UsedRange


    For i = 4 To lastrow

        v = Tabelle3.Cells(5 + i, 1)
        If v <> "" And Not IsError(Application.Match(v, Tabelle5.Range("A:A"), False)) Then

            r = Application.VLookup(v, myrange, 2, False)
            Tabelle3.Cells(5 + i, 2) = IIf(IsError(r), "No match", r)

        End If

        v = Tabelle5.Cells(i, 1)
        If IsError(Application.Match(v, Tabelle3.Range("A9:A" & _
               Tabelle3.Range("A1048576").End(xlUp).Offset(8).Row), False)) Then

            r = Application.VLookup(v, myrange, 1, False)
            Tabelle3.Cells(NFR + i, 1) = IIf(IsError(r), "No match", r)

            r = Application.VLookup(v, myrange, 2, False)
            Tabelle3.Cells(NFR + i, 2) = IIf(IsError(r), "No match", r)
        End If

    Next i

    Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)

    On Error Resume Next
    Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub