Hallo,
hatte die Anforderung so verstanden, dass es reicht, wenn die Sortierung absteigend ist.
Nachfolgend ein Skript, dass die höchsten Sortierschlüssel in den Gruppen mit "MAX" markiert. Bitte vorher ein Backup der Arbeitsmappe machen.
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"
Exit Sub
End If
l = l + 1
Loop
End With
MsgBox "Schlüssel " & sKey & " nicht gefunden..", vbInformation
End Sub
Gruß
|