VBA Tipp: Minimum, Maximum, arithmetisches Mittel, geometrisches Mittel, Standardabweichung

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Mir fehlen Funktionen zur Berechnung des Minimums, Maximums, des arithmetischen Mittels bzw. des geometrischen Mittels oder der Standardabweichung.

Lösung

Die folgenden Funktionen schließen diese Lücke:

Public Function fktMin(ParamArray P())
' Minimum
Dim V, I As Long
  V = Null
  For I = LBound(P) To UBound(P)
    If Not IsNumeric(V) Or (P(I) < V) Then V = P(I)
  Next I
  fktMin = V
End Function
 
Public Function fktMax(ParamArray P())
' Maximum
Dim V, I As Long
  V = Null
  For I = LBound(P) To UBound(P)
    If Not IsNumeric(V) Or (P(I) > V) Then V = P(I)
  Next I
  fktMax = V
End Function
 
Public Function fktAvg(ParamArray P())
' Arithmetisches Mittel
Dim V As Double, I As Long, N As Long
  V = 0#: N = 0
  For I = LBound(P) To UBound(P)
    If IsNumeric(P(I)) Then
      V = V + P(I)
      N = N + 1
    End If
  Next I
  If N = 0 Then
    fktAvg = Null
  Else
    fktAvg = V / N
  End If
End Function
 
Public Function fktGeo(ParamArray P())
' Geometrisches Mittel
Dim V As Double, I As Long, N As Long
  V = 1#: N = 0
  For I = LBound(P) To UBound(P)
    If IsNumeric(P(I)) Then
      N = N + 1
    End If
  Next I
  For I = LBound(P) To UBound(P)
    If IsNumeric(P(I)) Then
      V = V * (P(I) ^ (1 / N))
    End If
  Next I
  If N = 0 Then
    fktGeo = Null
  Else
    fktGeo = V
  End If
End Function
 
Public Function fktRMS(ParamArray P())
' Standardabweichung
Dim MW As Double, W As Double, I As Long, n As Long, V As Double
On Error GoTo Er
  fktRMS = Null
  n = 0
  Res = 0#
  For I = LBound(P) To UBound(P)
    If IsNumeric(P(I)) Then
      n = n + 1
      V = V + CDbl(P(I))
    End If
  Next I
  If n > 0 Then
    MW = Res / n
    n = 0
    Res = 0#
    For I = LBound(P) To UBound(P)
      If IsNumeric(P(I)) Then
        n = n + 1
        W = MW - CDbl(P(I))
        V = V + (W * W)
      End If
    Next I
    If n > 1 Then fktRMS = Sqr(V / (n - 1))
  End If
End Function

Aufruf

Debug.Print fktMin(12,123.3,1.23E-6)
 0,00000123
 
Debug.Print fktAvg(12,123.3,1.23E-6)
 45,10000041


Wiki hinweis.png Anmerkung: Nullwerte werden in den obigen Funktionen ignoriert, d.h. die Funktion liefert nur dann NULL, wenn alle Argumente NULL sind.