Удаление нескольких строк одновременно по диапазону ячеек

Question

Ошибка «Удалить метод класса диапазона» в строке emptyRows.EntireRow.Delete. Я пытаюсь сделать это, потому что я хочу удалить несколько строк одновременно, потому что, если я использую от For l oop до go над каждой ячейкой и удаляю одну за другой, то в непрерывных условных строках (первая ячейка attr пуста в моем case), одна условная строка остается, потому что номер строки изменяется после удаления предыдущей строки. Поэтому я хочу удалить все строки сразу, чтобы номер строки изменился ПОСЛЕ удаления всех строк. какое-либо решение?

Кстати, здесь функция trimData используется специально для обрезки только определенных c пробелов, поэтому не используется Trim(cell), поэтому игнорируйте это.

Sub deleteBlankRows()
    Call declareVars
    Dim lastCellFromBottom As Range
    Dim lRange As Range
    Dim emptyCells As Range
    Set lastCellFromBottom = Cells(ActiveSheet.Rows.Count, g_attrStartCell.Column).End(xlUp)
    'MsgBox lastCellFromBottom
    'MsgBox g_firstDataRangeCell.Address
    Set lRange = Range(lastCellFromBottom, g_firstDataRangeCell)


    For i = 1 To lRange.Count
        For Each Cell In lRange
            Call trimData(Cell)
            If Cell.Value = "" Then
                If i = 1 Then
                    Set emptyCells = Cell
                Else
                    Set emptyCells = Union(emptyCells, Cell)
                End If
            End If
        Next Cell
    Next i
    emptyCells.EntireRow.Delete
    Set g_dataLastCellOfStartAttr = g_attrStartCell.End(xlDown)
    g_dataLastRowNum = g_dataLastCellOfStartAttr.Row
    g_dataRange.Select
End Sub

Answer 1

Вместо For-Next я использовал Do-L oop. Тем не менее принцип тот же. Давайте начнем с примера, чтобы показать вам, как это работает:

Sub SubExample()

    '------------------------------------'
    'CODE ACCESSORY TO THE EXAMPLE: BEGIN'
    'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv'

    'Declarations
    Dim WksWorksheet01 As Worksheet
    Dim RngStart As Range
    Dim RngEnd As Range
    Dim LngCounter01 As Long
    Dim LngEndRow As Long
    Dim LngColumn As Long

    'Setting variables.
    Set WksWorksheet01 = ActiveWorkbook.Worksheets.Add
    Set RngStart = WksWorksheet01.Range("A2")
    Set RngEnd = WksWorksheet01.Range("A10")

    'Typing header.
    RngStart.Offset(-1, 0).Value = "List"

    'Filling in a list.
    For LngCounter01 = 0 To (RngEnd.Row - RngStart.Row)
        RngStart.Offset(LngCounter01, 0) = LngCounter01
    Next

    'Creating a random blank cell in the list.
    RngStart.Offset(Round(Rnd() * (RngEnd.Row - RngStart.Row), 0), 0).ClearContents

    '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
    'CODE ACCESSORY TO THE EXAMPLE: END'
    '----------------------------------'

    '---------------------------------'
    'CODE YOU ARE INTERESTED IN: BEGIN'
    'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv'

    'Setting variables.
    LngCounter01 = RngStart.Row
    LngColumn = RngStart.column
    LngEndRow = RngEnd.Row

    'Loop the code until the range we are processing is below the end of the list.
    Do Until LngCounter01 > LngEndRow
        'Selecting the cell we are processing (just to help you following the code, not necessary to the code).
        WksWorksheet01.Cells(LngCounter01, LngColumn).Select
        'Checking if the cell is empty.
        If WksWorksheet01.Cells(LngCounter01, LngColumn).Value = "" Then
            'Deleting the cell. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is blank. I'll delete the row", vbOKOnly
            'Deleting.
            WksWorksheet01.Cells(LngCounter01, LngColumn).EntireRow.Delete
            'We've deleted a row, so the end had also got closer. Setting LngEndRow accordingly.
            LngEndRow = LngEndRow - 1
        Else
            'Ignoring the cell and proceed to the next. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is not blank. Proceeding to the next one.", vbOKOnly
            'Setting LngCounter01 for the next row.
            LngCounter01 = LngCounter01 + 1
        End If
    Loop

    '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
    'CODE YOU ARE INTERESTED IN: END'
    ''------------------------------'

End Sub

Вы можете скопировать-вставить и запустить его. Это создаст новый лист и покажет вам, как это работает. Проверьте заметки тоже. Основываясь на этом примере, я попытался отредактировать ваш код. Вот с выделенными изменениями:

Sub deleteBlankRowsCHANGESHIGHLIGHTED()
    Call declareVars
    Dim lastCellFromBottom As Range

    '--------CUT--------
    'v v v v v v v v v v
    'Dim lRange As Range
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    Dim emptyCells As Range

    '---------ADDED---------
    'v v v v v v v v v v v v
    Dim LngCounter01 As Long
    Dim WksWorksheet01 As Worksheet
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    Set lastCellFromBottom = Cells(ActiveSheet.Rows.Count, g_attrStartCell.column).End(xlUp)
    'MsgBox lastCellFromBottom
    'MsgBox g_firstDataRangeCell.Address

    '----------------------------CUT----------------------------
    'v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
    'Set lRange = Range(lastCellFromBottom, g_firstdatarangecell)
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    '----------------------------------ADDED----------------------------------
    'v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
    'Setting variables.
    LngCounter01 = RngStart.Row
    LngColumn = RngStart.column
    LngEndRow = RngEnd.Row
    Set WksWorksheet01 = g_attrStartCell.Parent

    'Loop the code until the range we are processing is below the end of the list.
    Do Until LngCounter01 > LngEndRow
        'Selecting the cell we are processing (just to help you following the code, not necessary to the code).
        WksWorksheet01.Cells(LngCounter01, LngColumn).Select

        Call trimData(cell) '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< I'VE INSERTED YOUR COMMAND HERE


        'Checking if the cell is empty.
        If WksWorksheet01.Cells(LngCounter01, LngColumn).Value = "" Then
            'Deleting the cell. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is blank. I'll delete the row", vbOKOnly
            'Deleting.
            WksWorksheet01.Cells(LngCounter01, LngColumn).EntireRow.Delete
            'We've deleted a row, so the end had also got closer. Setting LngEndRow accordingly.
            LngEndRow = LngEndRow - 1
        Else
            'Ignoring the cell and proceed to the next. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is not blank. Proceeding to the next one.", vbOKOnly
            'Setting LngCounter01 for the next row.
            LngCounter01 = LngCounter01 + 1
        End If
    Loop
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    '-----------------CUT-----------------
    'v v v v v v v v v v v v v v v v v v v
    'For i = 1 To lRange.Count
    '    For Each cell In lRange
    '        Call trimData(cell)
    '        If cell.Value = "" Then
    '            If i = 1 Then
    '                Set emptyCells = cell
    '            Else
    '                Set emptyCells = Union(emptyCells, cell)
    '            End If
    '        End If
    '    Next cell
    'Next i
    'emptyCells.EntireRow.Delete
    '^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    Set g_dataLastCellOfStartAttr = g_attrStartCell.End(xlDown)
    g_dataLastRowNum = g_dataLastCellOfStartAttr.Row
    g_dataRange.Select

End Sub

Вот тот же код без подсветки:

Sub deleteBlankRowsREFORMED()
    Call declareVars
    Dim lastCellFromBottom As Range
    Dim emptyCells As Range

    Dim LngCounter01 As Long
    Dim WksWorksheet01 As Worksheet

    Set lastCellFromBottom = Cells(ActiveSheet.Rows.Count, g_attrStartCell.column).End(xlUp)
    'MsgBox lastCellFromBottom
    'MsgBox g_firstDataRangeCell.Address

    'Setting variables.
    LngCounter01 = RngStart.Row
    LngColumn = RngStart.column
    LngEndRow = RngEnd.Row
    Set WksWorksheet01 = g_attrStartCell.Parent

    'Loop the code until the range we are processing is below the end of the list.
    Do Until LngCounter01 > LngEndRow
        'Selecting the cell we are processing (just to help you following the code, not necessary to the code).
        WksWorksheet01.Cells(LngCounter01, LngColumn).Select

        Call trimData(cell) '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< I'VE INSERTED YOUR COMMAND HERE


        'Checking if the cell is empty.
        If WksWorksheet01.Cells(LngCounter01, LngColumn).Value = "" Then
            'Deleting the cell. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is blank. I'll delete the row", vbOKOnly
            'Deleting.
            WksWorksheet01.Cells(LngCounter01, LngColumn).EntireRow.Delete
            'We've deleted a row, so the end had also got closer. Setting LngEndRow accordingly.
            LngEndRow = LngEndRow - 1
        Else
            'Ignoring the cell and proceed to the next. I'll also inform you about it (not necessary to the code).
            MsgBox "This cell is not blank. Proceeding to the next one.", vbOKOnly
            'Setting LngCounter01 for the next row.
            LngCounter01 = LngCounter01 + 1
        End If
    Loop

    Set g_dataLastCellOfStartAttr = g_attrStartCell.End(xlDown)
    g_dataLastRowNum = g_dataLastCellOfStartAttr.Row
    g_dataRange.Select

End Sub

Надеюсь, это понятно. Скажите, удовлетворяет ли это вас, если вам нужны какие-либо объяснения или улучшения.