確定Excel概要組中的範圍

Question

我有一個Excel表單，其數據使用outline方法分組。

我有問題定義從組開始到組結束的範圍。

我有這樣的數據在userform填充listbox。

如果用戶選擇此組中的任何項目刪除我需要刪除整個組。

我想我已經在想它，但是有沒有一種很好的方法來定義這個範圍？ 這裏是我開始用下面

`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 

---

前後：