Excelのアウトライングループの範囲を特定します

Question

outlineメソッドを使用してグループ化されたデータを持つExcelシートがあります。

グループの先頭からグループの最後までの範囲を定義する際に問題があります。

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 

---

を前と後：