Блог

По сути, следующий поиск выполняется в столбце L листа 1, сравнивает его с другим столбцом на отдельном листе (например, Лист 2), а затем удаляет всю строку из листа 1.

У меня возникли проблемы с его применением в других ситуациях.

Можно ли вместо указания столбца «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" amp; Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
    If IsNumeric(Application.Match(.Range("L" amp; i).Value, Sheets(2).Columns("C"), 0)) Then .Rows(i).Delete
Next i
End With
End Sub
  

Очень признателен.

Что-то вроде этого должно сработать для вас:

 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