Hallo,

folgendes Problem bei dem ich zurzeit nicht weiter komme. Ich habe eine Tabelle mit drei Spalten für je ein Ergebnis und möchte daneben für jedes Ergebnis den Rang wissen. Bei der Bewertung ist kleiner besser und größer schlechter.

Allerdings soll an Stellen wo eine Null in den Ergebnisspalten steht, auch eine Null in der entsprechenden Rang Spalte stehen (d.h.V2_Gesa =0 dann auch V2 Final=0). Diese Null soll dann NICHT in die Bildung der Rangfolge miteinfließen, sodass z.Bsp. der Rang nur zwischen den Zahlen gebildet wird, die keine Null sind (s. Bilder).

Den Code zur bisherigen Rangermittlung habe ich unten angefügt.

Vielen Dank und beste Grüße!

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
 
'Arbeitsblatt festlegen
Set blatt = Worksheets("Ergebnis")
 
'Alle Zeilen in Spalte 1 ermitteln
ende = blatt.Cells(Rows.Count, 1).End(xlUp).Row
 
'Jetzt durch alle Zeilen und en Rang ermitteln, Start in Zeile 3
For zeile = 3 To ende
    'Werte aus den Spalten ziehen
    For i = 1 To 3
        werte(i) = blatt.Cells(zeile, 29 + i)
    Next i
    
    
    'Werte der ersten beiden vergleichen

   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
     
    'den dritten Wert
    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
    'ist größer als der Größte
        rang(3) = 3
        rang(2) = rang(2)
        rang(1) = rang(1)
        fertig = True
    End If
     
    If fertig = False And werte(kleinster) > werte(3) Then
    'ist kleiner als der Kleinste
        rang(3) = 1
        rang(2) = rang(2) + 1
        rang(1) = rang(1) + 1
        fertig = True
    End If
     
    'liegt dazwischen
    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
 
    'Rang eintragen     
    For i = 1 To 3
        blatt.Cells(zeile, 32 + i) = rang(i)
 
   Next i

Next zeile
Application.ScreenUpdating = True

End Sub