Guten Tag,

ich habe mir aus einem Makro, das fehlende Werte in einer Spalte mit einer Mittelwertberechnung ersetzt, versucht umzuschreiben, sodass der Median eingesetzt wird. (hab VBA vor Jahren mal in der schule gehabt)

Die form sieht so aus:

2
20
12
X
X
X
2

In dem Fall sollen die 3 Kreuze durch den Median aus den 3 Werten davor berechnet werden, also Median(2;12;20) --> 12.
Sprich, wenn x Werte fehlen, auch den Median aus x Werten berechnen.

Allerdings sieht es so aus, als würde immer der Median aus den zeilennummern bestimmt werden und nicht den Werten. In diesem Beispiel werden die Zellen durch  20 ersetzt und krieg das nicht behoben.

Gibt es nicht irgendeine Möglichkeit die Rechenrunktion Median einzubauen?
Ich danke schonmal jeden, der sich zeit nimmt, den Code anzugucken.

Function getMedianValues(rng As Range, i As Long, k As Long) As Double
Dim temp As Long
Dim returnVal As Double

        If (k > 60) Then
        k = 60
        End If
        
        Dim numbers() As Double
        ReDim numbers(k)
        temp = 0
        For n = (i - k) To (i - 1)
            numbers(temp) = rng(n, 1).Value
            temp = temp + 1
        Next n

        If k Mod 2 = 0 Then 'gerade
            returnVal = 0.5 * (numbers((k / 2) - 1) + numbers(k / 2)) 'Index startet bei 0 -> (k-1)&k statt k&(k+1) nötig
        Else 'ungerade
            returnVal = numbers((k - 1) / 2) 'Index startet bei 0 -> (k-1) statt (k+1) nötig
        End If
        
        'returnVal = numbers(k - 2)
        getMedianValues = returnVal
End Function


Function calcLength(counted_rows As Long, rng As Range, i As Long) As Long
Static tempval As Long
tempval = 0
    For j = i To counted_rows
        If rng(j, 1).Value <> "X" Then Exit For
            tempval = tempval + 1
            Next j
    calcLength = tempval
End Function

Sub interpolateX()
Dim i As Long
Dim j As Long
Dim m As Long
Dim n As Long
Static k As Long
Static k1 As Long
Dim rng As Range
Dim numbers As Double

Set rng = Range("A1:A550000") 'RANGE WIRD HIER MANUELL ANGEPASST

For i = 1 To rng.Rows.Count
    k = 0

    If rng(1, 1).Value = "X" Then
        If rng(2, 1).Value <> "X" Then
            rng(1, 1).Value = rng(2, 1).Value
            rng(1, 1).Interior.Color = RGB(200, 0, 0)
        Else
        k = calcLength(rng.Rows.Count, rng, i) 'Methoden-/Funktionsaufruf
        For m = i + 1 To (i + k - 1)
            rng(m, 1).Value = rng(i + k, 1).Value 'Formel mit Interpolation nur aus den unteren Werten
            rng(m, 1).Interior.Color = RGB(200, 0, 0)

        Next m
    End If
    ElseIf rng(i, 1).Value = "X" And rng(1, 1).Value <> "X" Then
        If rng(i + 1, 1).Value <> "X" And rng(i - 1, 1).Value <> "X" And IsEmpty(rng(i + 1, 1).Value) = False Then
            rng(i, 1).Value = (rng(i + 1, 1).Value + rng(i - 1, 1).Value) / 2 'Formel für Interpolation aus oberem und unterem Wert
            rng(i, 1).Interior.Color = RGB(200, 0, 0)

        Else
            k = calcLength(rng.Rows.Count, rng, i)
            If i <> 1 And IsEmpty(rng(i + 1, 1).Value) = False Then
                numbers = getMedianValues(rng, i, k)
                For m = i To (i + k - 1)
                    rng(m, 1).Value = numbers
                    rng(m, 1).Interior.Color = RGB(200, 0, 0)

                Next m
            ElseIf i <> 1 And IsEmpty(rng(i + 1, 1).Value) = True Then
                For m = i To (i + k - 1)
                    rng(m, 1).Value = rng(i - 1, 1).Value 'Formel für Interpolation nur aus den oberen Werten
                    rng(m, 1).Interior.Color = RGB(200, 0, 0)
                Next m
            End If
    End If
    End If
Next i

End Sub