Выбор диапазона между двумя словами затем на основе другого столбца, удаление их

Question

Я сделал оригинальный пост ( Выбор диапазона зависит от двух ключевых слов ).Мой код был правильным, однако он не делает то, что мне было нужно.Мне нужна помощь / руководство для манипулирования кодом, чтобы между доходом и общим доходом мы смотрели на столбец J, если он пустой, вся строка удаляется.Я старался изо всех сил, но поскольку я в настоящее время изучаю VBA, я изо всех сил пытаюсь найти даже, как приблизиться к этому.

Код до сих пор:

Dim rngFirst As Range
Dim rngLast As Range

Dim rngUnion As Range
Application.ScreenUpdating = False

With Sheets("Input")
    'Find the start and stop
    Set rngFirst = .Cells.Find(what:="Performance Income", lookat:=xlWhole, _
        LookIn:=xlValues, MatchCase:=False)
    Set rngLast = .Cells.Find(what:="Miscellaneous Income", _
        lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False)

    Set rngUnion = Range(rngFirst.Address, rngLast.Address)

    rngUnion.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End With

Application.ScreenUpdating = True

Я высоко ценю всю помощь и любую помощь.Спасибо.

Answer 1

Я рекомендую использовать Match, чтобы найти строки, в которых "Доход" и "Общий доход".Затем проверьте между этими строками, есть ли пробелы в столбце J .SpecialCells(xlCellTypeBlanks), и удалите EntireRow.

Option Explicit

Public Sub DeleteEmpty()
    Dim wsInput As Worksheet 'define worksheet
    Set wsInput = ThisWorkbook.Worksheets("Input")

    Dim FirstRow As Long, LastRow As Long

    On Error Resume Next 'Next line throws error if  "Revenue" or "Total Revenue" is not found
    FirstRow = Application.WorksheetFunction.Match("Revenue", wsInput.Range("A:A"), False) + 1
    LastRow = Application.WorksheetFunction.Match("Total Revenue", wsInput.Range("A:A"), False) - 1
    On Error GoTo 0 'Always re-activate error handling!

    'Check if both "Revenue" and "Total Revenue" were found
    If FirstRow = 0 Or LastRow = 0 Then
        MsgBox "Revenue or Total Revenue not found"
        Exit Sub
    End If

    'Find empty cells in column J between FirstRow (Revenue) and LastRow (Total Revenue)
    Dim EmptyCellsInJ As Range
    On Error Resume Next
    Set EmptyCellsInJ = wsInput.Range(wsInput.Cells(FirstRow, "J"), wsInput.Cells(LastRow, "J")).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    'If there are empty cells delete their rows
    If Not EmptyCellsInJ Is Nothing Then
        EmptyCellsInJ.EntireRow.Delete
    Else
        MsgBox "nothing to delete"
    End If
End Sub

.