Если нет совпадений sheet2, удалите строку sheet1. Разное количество заголовков

Question

Я нашел этот VBA и хочу, чтобы он удалил строки на sheet1, когда его нет на sheet2. Тем не менее, у меня есть 1-рядный заголовок в sheet2 и 2-рядный заголовок в sheet1. Я получаю код только для работы, когда оба листа имеют 1 заголовок строки. Кто-нибудь из вас, пожалуйста, скажите мне, что я делаю здесь не так: (

Sub DeleteNotMatch22()
Const sh1Col As String = "A"
Const sh2Col As String = "A"
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Long, r2 As Long, i As Long, x As Long
Set ws1 = Sheets("Sheet1") 'This one has 2 row header.
Set ws2 = Sheets("Sheet2") ' This one has 1 row header. 
r1 = ws1.Cells(Rows.Count, sh1Col).End(xlUp).Row
r2 = ws2.Cells(Rows.Count, sh2Col).End(xlUp).Row
On Error Resume Next
For i = 2 To r2
x = Application.Match(ws2.Cells(i, sh2Col), ws1.Range(sh1Col & "1:" & sh1Col & r1), 0)
ws1.Cells(x, 255) = "xx"
Next i
ws1.Cells(1, 255) = "xx"
Intersect(ws1.UsedRange, ws1.Columns(255)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ws1.Columns(255).ClearContents
End Sub

Answer 1

Вы можете попробовать это:

Option Explicit

Sub DeleteNotMatch22()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim r1 As Long, r2 As Long, i As Long

    'Set  worksheets
    With ThisWorkbook
        Set ws1 = .Sheets("Sheet1")
        Set ws2 = .Sheets("Sheet2")
    End With

    'Find Last rows
    r1 = ws1.cells(ws1.Rows.Count, "A").End(xlUp).Row
    r2 = ws2.cells(ws2.Rows.Count, "A").End(xlUp).Row

    'Loop sheet 1, column A starting from the botton to top up to row 3
    For i = r1 To 3 Step -1
        'If the value of sheet 1, column A row i appears sheet 2 range A2:A lastrow
        If Application.WorksheetFunction.CountIf(ws2.Range("A2:A" & r2), ws1.Range("A" & i).Value) = 0 Then
            ws1.Rows(i).Delete
        End If
    Next i

End Sub