Option Explicit
Sub Bearbeiten()
Dim lngLaufZahl As Long
Dim lngZielZeile As Long
Dim lngID As Long
Dim datStart As Date
Dim strKD As String
ThisWorkbook.Sheets("Tabelle1").Activate
With ActiveSheet
.UsedRange.Select
Selection.Sort Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range( _
"C2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
datStart = CDate(.Range("B2"))
strKD = CStr(.Range("C2"))
lngID = 1
For lngLaufZahl = 2 To .UsedRange.Rows.Count
If CDate(.Cells(lngLaufZahl, 2)) = datStart Then
If CStr(.Cells(lngLaufZahl, 3)) = strKD Then
.Cells(lngLaufZahl, 1) = lngID
Else
lngID = lngID + 1
strKD = CStr(.Cells(lngLaufZahl, 3))
.Cells(lngLaufZahl, 1) = lngID
End If
Else
datStart = CDate(.Cells(lngLaufZahl, 2))
strKD = CStr(.Cells(lngLaufZahl, 3))
lngID = lngID + 1
.Cells(lngLaufZahl, 1) = lngID
End If
Next lngLaufZahl
lngID = 0
lngZielZeile = 2
For lngLaufZahl = 2 To .UsedRange.Rows.Count
If .Cells(lngLaufZahl, 1) <> lngID Then
ThisWorkbook.Sheets("Tabelle2").Cells(lngZielZeile, "A") = .Cells(lngLaufZahl, 1)
ThisWorkbook.Sheets("Tabelle2").Cells(lngZielZeile, "B") = .Cells(lngLaufZahl, 2)
ThisWorkbook.Sheets("Tabelle2").Cells(lngZielZeile, "C") = .Cells(lngLaufZahl, 3)
lngZielZeile = lngZielZeile + 1
lngID = .Cells(lngLaufZahl, 1)
End If
Next lngLaufZahl
End With
End Sub