识别Excel大纲组中的范围

Question

我有一张Excel工作表，其中包含使用outline方法分组的数据。

我在定义从组的开头到组末尾的范围时遇到问题。

我在listbox中填充userform这个数据。

如果用户选择了该组中的任何项目进行删除，我需要删除整个组。

我认为我过度思考但是有一个很好的方法来定义这个范围吗？ 以下是我在下面开始的示例

`Sub delrows()
 Dim StartRow As Integer
 Dim EndRow As Integer
 'if outline level should never drop below 2.
 'If it is 2 then this will always be the beginning of the range.

 If ActiveCell.Rows.OutlineLevel = 2 Then
     y = ActiveCell.Row
 Else
     y = ActiveCell.Row + 3 
 'y= needs to look up until it see a 2 then go back down 1 row
 End If


 If ActiveCell.Rows.OutlineLevel <> 2 Then
     x = ActiveCell.Row + 1 
 'x = needs to look down until it finds next row 2 then back up 1 row

 Else
     x = ActiveCell.Row
 End If


 StartRow = y
 EndRow = x

 Rows(StartRow & ":" & EndRow).Select '.Delete



 End Sub`

做了一点点工作。将大纲级别存储为AA列中的工作表上的值。

Sub delrows()
 Dim StartRow As Integer
 Dim EndRow As Integer
 Dim Rng As Range
 Dim C As Range
 Dim B As Range
 'if outline level shoudl never drop below 2.
 'If it is 2 then this will always be the begining of the range.

 If ActiveCell.Rows.outlinelevel = 2 Then
 'If ActiveCell = 2 Then

     y = ActiveCell.Row
 Else

     Set Rng = Range("AA:AA")
     Set B = Rng.Find(What:="2", After:=ActiveCell,LookIn:=xlFormulas,LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
     y = B.Offset(0, 0).Row
 End If


 If ActiveCell.Rows.outlinelevel <> 2 Then

         Set Rng = Range("AA:AA")
     Set C = Rng.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
     x = C.Offset(-1, 0).Row

  Else
     If ActiveCell.Rows + 1 = 3 Then
         Set Rng = Range("AA:AA")
         Set C = Rng.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
         x = C.Offset(-1, 0).Row
     Else
         x = ActiveCell.Row
     End If

 End If


 StartRow = y
 EndRow = x

 Rows(StartRow & ":" & EndRow).Delete

 End Sub

Answer 1

试试这个：

Option Explicit

Public Sub RemoveGroup()
    Dim grpStart As Range, grpEnd As Range, lvl As Long

    Set grpStart = Sheet1.Range("A7").EntireRow     'test cell - A7
    Set grpEnd = grpStart
    lvl = grpStart.OutlineLevel

    While lvl = grpStart.OutlineLevel   'find start of current group (up)
        Set grpStart = grpStart.Offset(-1)
    Wend
    Set grpStart = grpStart.Offset(1)   'exclude 1st row in next group

    While lvl = grpEnd.OutlineLevel     'find end of current group (down)
        Set grpEnd = grpEnd.Offset(1)
    Wend
    Set grpEnd = grpEnd.Offset(-1)      'exclude 1st row in next group

    With Sheet1.Rows(grpStart.Row & ":" & grpEnd.Row)
        .ClearOutline
        .Delete
    End With
End Sub

之前和之后：