VBA - выделить / удалить строку, если диапазон пуст

Question

У меня есть диапазон данных с идентификаторами CASE в столбце A и проблемами (от 1 до 10 или столбцами с B по K) в столбцах B.

Как только некоторые проблемы исключены как «нормальные»', они будут удалены из списка вопросов на основе соответствующего столбца.Например: CASE ID # 25, проблема 4 определяется как OK, тогда она будет удалена из строки 25, столбца 5 (или столбца E), но идентификатор CASE останется.

Цель состоит в том, что, выполнив эту проверку после факта, он может оставить некоторые строки полностью пустыми, начиная со столбца B (поскольку идентификатор CASE уже будет там).

Мой код нене работает успешно.После запуска он выделяет несколько строк, которые не являются полностью пустыми в целевом диапазоне.

Я пытаюсь определить строки в диапазоне B2:P & lastrow, где вся строка пуста, а затем выделить эти строки и затем удалить их.

Код:

Public Sub EmptyRows()


lastrow = Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).row
On Error Resume Next
Sheets("Issues").Activate
For Each rng In Range("B2:P" & lastrow).Columns
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Interior.ColorIndex = 11
    'rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rng

Application.ScreenUpdating = True


End Sub

Цель первого выделения - проверить работоспособность кода.В случае успеха они будут полностью удалены.

Answer 1

Ваше описание говорит о столбцах от B до K, но в вашем коде от B до P ...

Вы можете сделать это следующим образом (отрегулируйте размер для соответствующих столбцов):

Public Sub EmptyRows()
    Dim lastRow As Long, sht As Worksheet, c As Range, rngDel As Range

    Set sht = Sheets("Issues")

    For Each c In sht.Range(sht.Range("A2"), sht.Cells(Rows.Count, 1).End(xlUp)).Cells
        If Application.CountA(c.Offset(0, 1).Resize(1, 10)) = 0 Then

            'build range to delete
            If rngDel Is Nothing Then
                Set rngDel = c
            Else
                Set rngDel = Application.Union(rngDel, c)
            End If

        End If
    Next c

    'anything to flag/delete ?
    If Not rngDel Is Nothing Then
        rngDel.EntireRow.Interior.ColorIndex = 11
        'rngDel.EntireRow.Delete '<< uncomment after testing
    End If

End Sub

Answer 2

После запуска выделяются несколько строк, которые не являются полностью пустыми в целевом диапазоне.

Это потому, что вы выбираете все пробелы, а не толькостроки, в которых вся строка пуста.

См. приведенный ниже код

Public Sub EmptyRows()

With Sheets("Issues")

    lastrow = .Cells(Rows.Count, "A").End(xlUp).row    

    Dim rng as Range
    For Each rng In .Range("B2:B" & lastrow)

          Dim blankCount as Integer
          blankCount = Application.WorksheetFunction.CountA(rng.Resize(1,.Range("B:P").Columns.Count)) 

          If blankCount = .Range("B" & lastRow & ":P" & lastRow).Columns.Count Then

              Dim store as Range
              If store Is Nothing Then Set store = rng Else: Set store = Union(rng, store)

          End If

    Next rng

End With

store.EntireRow.Interior.ColorIndex = 11
'store.EntireRow.Delete

End Sub

Сначала сбор диапазонов, а затем их изменение (изменение цвета или удаление) поможет выполнить код быстрее.

Answer 3

Вот другой подход, использующий CountA

For Each cell In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Dim rng As Range
    Set rng = Range("A" & cell.Row & ":" & "P" & cell.Row)

    If Application.WorksheetFunction.CountA(rng) = 1 Then
        rng.EntireRow.Interior.ColorIndex = 11
    End If
Next cell