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
iColOut = 3
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(z, iColGrp) = .Cells(l, iColGrp)
If
.Cells(z, iColSort) > tmp
Then
tmp = .Cells(z, iColSort)
End
If
z = z + 1
Loop
Call
mark_max_group_sort(l, wks, iColGrp, iColSort,
CStr
(.Cells(l, iColGrp) & tmp), iColOut)
l = z
l = l + 1
Loop
End
With
Set
wks =
Nothing
End
Sub
Private
Sub
mark_max_group_sort(
ByVal
l
As
Long
,
ByRef
wks
As
Worksheet,
ByVal
iColGrp
As
Integer
,
ByVal
iColSort
As
Integer
,
ByVal
sKey
As
String
, iColOut
As
Integer
)
Dim
tmp
As
String
With
wks
Do
While
Not
.Cells(l, iColGrp) = vbNullString
tmp = .Cells(l, iColGrp) & .Cells(l, iColSort)
If
tmp = sKey
Then
.Cells(l, iColOut) =
"MAX"
Exit
Sub
End
If
l = l + 1
Loop
End
With
MsgBox
"Schlüssel "
& sKey &
" nicht gefunden.."
, vbInformation
End
Sub