如果没有匹配的sheet2,则删除行sheet1。标头数量不同

时间:2019-03-18 11:16:50

标签: excel vba

我找到了此VBA,并且希望它在sheet2上找不到它时删除sheet1上的行。但是,我在sheet2中有1行标题,在sheet1中有2行标题。我得到的代码仅在两个工作表都有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

1 个答案:

答案 0 :(得分: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