时间戳

首页 > 解决方案 > 删除所选摘要行下方的隐藏分组行

excel - 删除所选摘要行下方的隐藏分组行

问题描述

我在宏中使用以下代码从“模板”表中复制所有行并将它们粘贴到活动表中。然后，除了粘贴的第一行之外的所有行都被分组并“折叠”，即 RowLevels:=1。

If .Outline.SummaryRow <> xlSummaryAbove Then .Outline.SummaryRow = xlSummaryAbove
            csLastRow = copySheet.Cells(Rows.Count, 1).End(xlUp).Row
            copySheet.Range("2:" & csLastRow).Copy
            .Rows(LRow).PasteSpecial Paste:=xlPasteAll
            .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(.Rows.Count, 1).End _
                                           (xlUp).Offset(-(csLastRow - 3), 1)).EntireRow.Group
             ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=0

如图所示，此宏反复运行以创建一长串摘要行，每个行下方都有折叠的分组行。

在此处输入图像描述

目的是能够删除汇总行及其下方的折叠组（如果工作表上不再需要）。正如预期的那样，手动完成时，单击摘要行并将其删除，只会删除摘要行并将其下方的隐藏行附加到相邻组。

有没有办法选择摘要行并将其连同其下方隐藏的分组行一起删除？我如何引用组的第一行和最后一行相对于其上方选定的摘要行以便使用 vba 删除？

标签： excelvba

解决方案

请测试下一个代码。由于您的图片未显示列标题（如果其中任何一个被隐藏），代码假定您希望根据“B：B”列中的单元格值来限定要删除的组（参见strCat值）：

Sub DeleteSpecificGroup() 
   Dim ws As Worksheet, lastRow As Long, firstR As Long, cellC As Range
   Dim strCat As String, i As Long, firsGRow As Long, lastGRow As Long

    strCat = "Category 3"      'use there the category you need
       Set ws = ActiveSheet   'use here the sheet you need
       lastRow = ws.Range("A" & ws.rows.count).End(xlUp).row
       Set cellC = ws.Range("B2:B" & lastRow).Find(What:=strCat, After:=ws.Range("B2"), _
                                                                        LookIn:=xlValues, Lookat:=xlWhole)
       If Not cellC Is Nothing Then
           firsGRow = cellC.row                      'first row of the group to be deleted
            If ws.rows(cellC.row + 1).OutlineLevel > 1 Then
                 For i = cellC.row + 1 To lastRow
                     If ws.rows(i).EntireRow.ShowDetail Then
                        ws.rows(i).EntireRow.Hidden = False
                     Else
                         lastGRow = i - 1: Exit For  'last row of the group to be deleted
                     End If
                 Next i
            End If
        Else
            MsgBox strCat & " could not be found in column ""B:B""...": Exit Sub
        End If
         ws.rows(firsGRow & ":" & lastGRow).EntireRow.Delete
End Sub

编辑：

要根据组摘要行选择删除组，请使用以下代码：

Sub DeleteSpecificSelectedGroup()
   Dim ws As Worksheet, lastRow As Long, firstR As Long
   Dim i As Long, firsGRow As Long, lastGRow As Long
      
       Set ws = ActiveSheet   'use here the sheet you need
       lastRow = ws.UsedRange.Rows.Count
           If ws.Outline.SummaryRow <> xlSummaryAbove Then ws.Outline.SummaryRow = xlSummaryAbove
           firsGRow = Selection.Row
           Application.Calculation = xlCalculationManual
            If ws.Rows(firsGRow + 1).OutlineLevel > 1 Then
                 For i = firsGRow + 1 To lastRow + 500
                     If ws.Rows(i).EntireRow.ShowDetail And ws.Rows(i).OutlineLevel > 1 Then
                        ws.Rows(i).EntireRow.Hidden = False
                     Else
                         lastGRow = i - 1: Exit For  'last row of the group to be deleted
                     End If
                 Next i
            End If
         ws.Rows(firsGRow & ":" & lastGRow).EntireRow.Delete
         Application.Calculation = xlCalculationAutomatic
End Sub

推荐阅读