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