Hallo Anja,
um zu vermeiden, dass Excel keine Rückmeldung mehr gibt, habe ich DoEvents hinzugefügt. Probiere es bitte noch einmal 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)
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(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
Dein Ansatz ist auch gut, würde aber voraussetzen, dass ich den Beginn der Gruppe an die "Markier"-Methode übergebe.
Wenn die Performance viel zu schlecht ist, würde ich das evtl. noch einbauen.
Gruß
|