确定Excel概要组中的范围

问题描述：

我有一个Excel表单，其数据使用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

答

试试这个：

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

前后：

确定Excel概要组中的范围

相关推荐