Option
Explicit
Public
Sub
sort_groups()
Dim
l
As
Long
, z
As
Long
Dim
iColGrp
As
Integer
, iColSort
As
Integer
, iColOut
As
Integer
, tmp
As
Integer
Dim
wks
As
Worksheet
l = 2
iColGrp = 1
iColSort = 2
Set
wks = Worksheets(
"Tabelle1"
)
With
wks
Do
While
.Cells(l, iColGrp) <> vbNullString
And
.Cells(l, iColSort) <> vbNullString
tmp =
CInt
(.Cells(l, iColSort))
z = l
Do
While
.Cells(l, iColGrp) = .Cells(z, iColGrp)
If
.Cells(l, iColSort) > tmp
Then
tmp = .Cells(l, iColSort)
End
If
l = l + 1
Loop
Call
mark_max_group_sort(wks, iColGrp, iColSort, .Cells(z, iColGrp), tmp)
DoEvents
Loop
End
With
Set
wks =
Nothing
End
Sub
Private
Sub
mark_max_group_sort(
ByRef
wks
As
Worksheet,
ByVal
iColGrp
As
Integer
,
ByVal
iColSort
As
Integer
,
ByVal
sGrp
As
String
,
ByVal
sSort
As
String
)
Dim
tmp
As
String
Dim
l
As
Long
l = 1
With
wks
Do
While
.Cells(l, iColGrp) <> vbNullString
And
.Cells(l, iColSort) <> vbNullString
tmp =
CStr
(.Cells(l, iColGrp) & .Cells(l, iColSort))
If
tmp =
CStr
(sGrp & sSort)
Then
.Cells(l, iColSort).Interior.Color = RGB(255, 0, 0)
End
If
l = l + 1
Loop
End
With
End
Sub