AW: TopTen und restliche Zeilen gruppieren
02.10.2009 23:00:43
Josef
Hallo Peter,
Sub GroupTopTen()
Dim lngRow As Long, lngLast As Long, lngGroup As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False
With ActiveSheet
.Range("A1").CurrentRegion.ClearOutline
lngLast = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row, 2) + 1
.Range("A1").CurrentRegion.Sort Key1:=.Range("D2"), _
Order1:=xlAscending, _
Key2:=.Range("E2"), _
Order2:=xlDescending, _
Header:=xlGuess
lngGroup = 2
For lngRow = 2 To lngLast
If .Cells(lngRow, 4) <> .Cells(lngGroup, 4) Then
If lngRow - 1 > lngGroup + 9 Then
.Range(.Cells(lngGroup + 10, 1), .Cells(lngRow - 1, 1)).EntireRow.Group
lngGroup = lngRow
End If
End If
Next
.Outline.ShowLevels RowLevels:=1
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
Gruß Sepp