excel - 按单元格范围一次删除多行

Question

“范围类的删除方法失败”错误即将出现emptyRows.EntireRow.Delete。我正在尝试这样做，因为我想一次删除多行，因为如果我使用 For 循环遍历每个单元格并逐个删除，那么在连续条件行中（在我的情况下，第一个 attr 单元格空白），一个条件留下行是因为在我删除前一行后行号发生了变化。所以我想一次删除所有行，以便在删除所有行后行号发生变化。任何解决方案？

顺便说一句，这里的trimData函数专门用于修剪特定的空格，所以不使用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

标签： excelvba

Answer 1

而不是 For-Next 我使用了 Do-Loop。原理还是一样的。让我们从示例开始，向您展示它是如何工作的：

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

希望它很清楚。告诉我它是否满足您，如果您需要任何解释或改进。