Question

基本上以下搜索Sheet1中的列L，将其与单独工作表中的另一列（例如Sheet2）进行比较，然后从Sheet1中删除整行。

我无法将其应用于其他情况。

是否可以轻松编辑以搜索列标题并继续执行相同的作业，而不是指定列“L”？

我知道那里有非常相似的问题，但没有找到解决这种特殊情况的运气。

Sub F_Check_List()
'Checks first sheet in workbook, column L for Headings matching Sheet2 column C and deletes those that match
    Dim LR As Long, i As Long
With Sheets(1)
    LR = .Range("L" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
    If IsNumeric(Application.Match(.Range("L" & i).Value, Sheets(2).Columns("C"), 0)) Then .Rows(i).Delete
Next i
End With
End Sub

非常感谢。

Answer 1

这样的事情对你有用：

Sub tgr()

    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rDel As Range
    Dim rHeader1 As Range
    Dim rHeader2 As Range
    Dim rCheck As Range
    Dim sHeader As String

    Set wb = ActiveWorkbook
    Set ws1 = wb.Sheets(1)
    Set ws2 = wb.Sheets(2)
    sHeader = "HeaderB"         'Change this to the header you are searching for

    Set rHeader1 = ws1.Rows(1).Find(sHeader, , xlValues, xlWhole)
    If rHeader1 Is Nothing Then Exit Sub    'Can't find header

    Set rHeader2 = ws2.Rows(1).Find(sHeader, , xlValues, xlWhole)
    If rHeader2 Is Nothing Then Exit Sub    'Can't find header

    For Each rCheck In ws1.Range(rHeader1.Offset(1), ws1.Cells(ws1.Rows.Count, rHeader1.Column).End(xlUp)).Cells
        If WorksheetFunction.CountIf(ws2.Columns(rHeader2.Column), rCheck.Value) > 0 Then
            If rDel Is Nothing Then Set rDel = rCheck Else Set rDel = Union(rDel, rCheck)
        End If
    Next rCheck

    If Not rDel Is Nothing Then rDel.EntireRow.Delete xlShiftUp

End Sub

搜索两个列标题，仅比较和删除一个工作表中的重复行。

1 个答案: