Sub Rang_Gesamt()
Dim ende As Long
Dim blatt As Object
Dim zeile As Long
Dim werte(3)
Dim rang(3)
Dim i As Long
Dim fertig As Boolean
Dim größter As Long
Dim kleinster As Long
Application.ScreenUpdating = False
Set blatt = Worksheets("Ergebnis")
ende = blatt.Cells(Rows.Count, 1).End(xlUp).Row
For zeile = 3 To ende
For i = 1 To 3
werte(i) = blatt.Cells(zeile, 29 + i)
Next i
If werte(2) > werte(1) Then
rang(2) = 2
rang(1) = 1
größter = 2
kleinster = 1
ElseIf werte(2) = werte(1) Then
rang(2) = 1
rang(1) = 1
größter = 1
kleinster = 1
Else
rang(2) = 1
rang(1) = 2
größter = 1
kleinster = 2
End If
fertig = False
If werte(3) = werte(1) Then
rang(3) = rang(1)
fertig = True
End If
If werte(3) = werte(2) Then
rang(3) = rang(2)
fertig = True
End If
If fertig = False And werte(größter) < werte(3) Then
rang(3) = 3
rang(2) = rang(2)
rang(1) = rang(1)
fertig = True
End If
If fertig = False And werte(kleinster) > werte(3) Then
rang(3) = 1
rang(2) = rang(2) + 1
rang(1) = rang(1) + 1
fertig = True
End If
If fertig = False And werte(3) < werte(größter) And werte(3) > werte(kleinster) Then
rang(3) = rang(kleinster) + 1
rang(größter) = rang(größter) + 1
End If
For i = 1 To 3
blatt.Cells(zeile, 32 + i) = rang(i)
Next i
Next zeile
Application.ScreenUpdating = True
End Sub