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

时间:2020-04-26 18:38:13

标签: excel vba

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

1 个答案:

答案 0 :(得分:0)

我使用了下环而不是下一个。原理仍然是相同的。让我们从示例开始,向您展示其工作原理:

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

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