Excel: Wert suchen, der am ehesten einem anderen Wert entspricht

Gepostet am: Feb 11, 2011 9:45:49 AM

Mal angenommen man möchte von einer Liste einen Wert suchen, der am ehesten einen anderen Wert entspricht kann man folgende Funktion verwenden:

{=INDEX(Bereich_der_ausgegeben_werden_soll;VERGLEICH(MIN(ABS(Bereich_der_verglichen_werden_soll-Vergleichswert));ABS(Bereich_der_verglichen_werden_soll-Vergleichswert);0))}

Anmerkung: Matrix-Formel

Beispiel: Der Student mit dem besten 4er.

Beispiel: der beste Student

Beispiel: Der Monat der am ehesten eine bestimmte Temperatur hat

Beispiel: Der durchschnittlichste Springer

Da die Formel aber in meinen Augen nicht sonderlich übersichtlich ist - hier die VBA-Lösung für dieses Problem. 

amehesten(Ausgaberbereich;Verlgleichsbereicht;Vergleichswert[;Vergleichsart])

Public Function amehesten(Ausgabebereich As Range, Vergleichsbereich As Range, Wert As Double, Optional iVergleichsart As Integer = 0) As VariantDim mR As Range Dim myArr() As VariantDim i As IntegerDim n As IntegerDim min As DoubleDim aktWert As DoubleDim minValue As Variant  min = 500000000' wenn die Bereiche ungleich groß sindIf Ausgabebereich.Count <> Vergleichsbereich.Count Then     amehesten = "#Fehler"     Exit FunctionEnd If' wenn die Bereiche gleich groß sindReDim myArr(Vergleichsbereich.Count - 1, 2)'Ausgabebereich in Array schreiben i = 0For Each mR In Ausgabebereich     myArr(i, 2) = mR.Value     i = i + 1Next'Vergleichsbereich in Array schreiben & Differenz i = 0For Each mR In Vergleichsbereich     aktWert = mR.Value     myArr(i, 0) = mR.Value     If iVergleichsart = 0 Then         myArr(i, 1) = Abs(Wert - mR.Value)     ElseIf iVergleichsart = 1 Then         If Wert - mR.Value > 0 Then             myArr(i, 1) = Wert - mR.Value         Else             myArr(i, 1) = min         End If     ElseIf iVergleichsart = 2 Then         If Wert - mR.Value < 0 Then             myArr(i, 1) = Abs(Wert - mR.Value)         Else             myArr(i, 1) = min         End If     End If     i = i + 1Next' den Wert im Array ermitteln, der am wenigsten vom gesuchten Wert divergiertFor n = 0 To (i - 1)    Debug.Print "prüfe" & n & ":" & min & "<" & myArr(n, 1)    If min > myArr(n, 1) Then       min = myArr(n, 1)       minValue = myArr(n, 2)    End IfNext n  amehesten = minValue End Function