Klar, so:
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 'Zeile, in der begonnen wird, bei Tabellen mit Überschrift = 2
iColGrp = 1 'Spalte, in der die Gruppe steht (Ganzzahliger Wert)
iColSort = 2 'Spalte, in der das Sortierkriterium steht (Ganzzahliger Wert)
iColOut = 3 'Spalte, in der die Markierung gesetzt werden soll (Ganzzahliger Wert)
Set wks = Worksheets("Tabelle1") 'Tabelle, die bearbeitet werden soll
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"
.Cells(l, iColSort).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
l = l + 1
Loop
End With
MsgBox "Schlüssel " & sKey & " nicht gefunden..", vbInformation
End Sub
Gruß
|