删除选定的行

时间:2018-07-24 03:58:54

标签: excel vba

目标:在表中,允许用户选择行(SELECTION所在的行),按下快捷键并删除这些行。无论它们是否被过滤并且选择是否在不连续的范围内。

我有下面的代码是我从另一个站点获得的,并对其进行了修改:

问题有所不同,从运行时错误1004:无法将已过滤范围或表中的单元格移到删除类的方法失败(或某些情况下,发生这种情况的频率比第一次一个)

Sub DeleteTableRows()
    'PURPOSE: Delete table row based on user's selection
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Dim rng As Range
    Dim DeleteRng As Range
    Dim cell As Range
    Dim TempRng As Range
    Dim Answer As Variant
    Dim area As Range
    Dim ReProtect As Boolean
    Dim copyRange As Range
    Dim pasteRange As Range
    Dim wb As Workbook
    Dim a As Long

    'Set Range Variable
      On Error GoTo InvalidSelection
        Set rng = Selection
      On Error GoTo 0


    'Unprotect Worksheet
      With ThisWorkbook.ActiveSheet
        If .ProtectContents Or ProtectDrawingObjects Or ProtectScenarios Then
          On Error GoTo InvalidPassword
          .Unprotect Password
          ReProtect = True
          On Error GoTo 0
        End If
      End With

      Set wb = ThisWorkbook

    'Loop Through each Area in Selection
      For Each area In rng.Areas
        For Each cell In area.Cells.Columns(1)
          'Is selected Cell within a table?
            InsideTable = True

          'Gather rows to delete
            If InsideTable Then
              On Error GoTo InvalidActiveCell
              Set TempRng = Intersect(cell.EntireRow, ActiveCell.ListObject.DataBodyRange)
              On Error GoTo 0

              If DeleteRng Is Nothing Then
                Set DeleteRng = TempRng
              Else
                Set DeleteRng = Union(TempRng, DeleteRng)
              End If

            End If

        Next cell
      Next area


    'Error Handling
      If DeleteRng Is Nothing Then GoTo InvalidSelection
      If DeleteRng.Address = ActiveCell.ListObject.DataBodyRange.Address Then GoTo DeleteAllRows
      If ActiveCell.ListObject.DataBodyRange.Rows.Count = 1 Then GoTo DeleteOnlyRow

    'Ask User To confirm delete (since this cannot be undone)
        DeleteRng.Select

        If DeleteRng.Rows.Count = 1 And DeleteRng.Areas.Count = 1 Then
          Answer = MsgBox("Are you sure you want to delete the currently selected table row? " & _
           " This cannot be undone...", vbYesNo, "Delete Row?")
        Else
          Answer = MsgBox("Are you sure you want to delete the currently selected table rows? " & _
           " This cannot be undone...", vbYesNo, "Delete Rows?")
        End If

    'Delete row (if wanted)
      If Answer = vbYes Then

        'this part is giving me troubles
        For a = DeleteRng.Areas.Count To 1 Step -1
            Debug.Print DeleteRng.Areas.Count
            DeleteRng.Areas(a).EntireRow.Delete
        Next a

      End If

    'Protect Worksheet
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True  

End Sub

2 个答案:

答案 0 :(得分:3)

我认为您在这里遇到了几个问题,但是可以肯定的是,这似乎是违反直觉的。

以编程方式删除多个非连续的行/列/单元格/区域时,最好相反地进行


当您删除一行时,Excel会将其下方的行向上移动 。因此,随后的行号很容易混淆,从而导致错误,或者更糟糕的是,意外丢失了数据。

  

示例

     

假设您要删除1, 4, 5 and 7行。如果从顶部开始一次删除它们一次,则将删除行1,这将使其他行编号删除3, 4 and 6。删除3,现在您需要删除3 and 5

     

要一次从顶部开始一次删除行1, 4, 5 and 7,实际上您需要删除行1, 3, 3, and 4(是的,您将删除行3两次)


有几种解决方法:

  1. 一次删除所有行。您可以将每个选定的行与the Union method连接起来,然后将整个范围删除为一个。

或者,我的偏好:

  1. 从数据底部开​​始依次向上遍历向后行。由于无法使For..Each循环反向,因此您需要切换到For..Next

    您可以使用the Range.End property找到最后一个填充的行(在我的示例中使用A列),然后使用the Intersect method将每一行与行和/或单元格的user's .Selection进行比较。如果它们两个相交,则可以.Delete the row


示例:

Sub DeleteSelectedRows()
    Dim rw As Long, lastRow As Long, del As Long
    With Workbooks("book1").Sheets("Sheet1")
        lastRow = .Cells(ws.Rows.Count, 1).End(xlUp).Row 'find last row of Column #1 (A)
        For rw = lastRow To 1 Step -1 'loop through rows backwards
            If Not Intersect(Selection, Rows(rw).Cells) Is Nothing Then
                'This row is within the selected worksheets range(s)
                Rows(rw).Delete 'delete row
                del = del + 1 'count deletion (only for troubleshooting)
            End If
        Next rw
    End With
    MsgBox del & " rows were deleted."
End Sub

上面的过程将需要进行一些小的更改,以适应工作表上数据的位置,但是对我来说是完美的测试。

请注意,我上面的帖子中有几个链接...在使用不熟悉的命令之前,请务必先阅读官方文档。这也将有助于术语,因为有很多东西要习惯! ...例如您滥用术语Selection的方式...除非您使用Select方法,否则VBA不会选择行。常见的错误。 :-)祝你好运!

答案 1 :(得分:0)

很好的解释,正如马克·菲茨杰拉德(Mark Fitzgerald)所说,没有声明“ .ws”,在我声明后出现了一些错误。

我刚刚擦除并工作了!

Sub DeleteSelectedRows()
    Dim rw As Long, lastRow As Long, del As Long, ws As Long
    With Planilha12
        lastRow = .Cells(Rows.Count, 3).End(xlUp).Row 'find last row of Column #1 (A)
        For rw = lastRow To 1 Step -1 'loop through rows backwards
            If Not Intersect(Selection, Rows(rw).Cells) Is Nothing Then
                'This row is within the selected worksheets range(s)
                Rows(rw).Delete 'delete row
                del = del + 1 'count deletion (only for troubleshooting)
            End If
        Next rw
    End With
    Range("C19").Select 'select the cell that I want
    Planilha11.Calculate 'calculate the sheet I want
    MsgBox del & " rows were deleted." 
End Sub