'Filters out variations of a data field, the numerical values and delivers them back. Possibly. 0-values are ignored
Public Function ZahlenFilter(ByVal varArr As Variant, Optional ByVal bolIgnoreZero As Boolean = False) As Variant
Dim lngLB As Long, lngUB As Long, lngCnt As Long, lngVar As Long
Dim dblVals() As Double
lngLB = LBound(varArr)
lngUB = UBound(varArr)
For lngVar = lngLB To lngUB
If IsNumeric(varArr(lngVar)) Then
If Not bolIgnoreZero Or CDbl(varArr(lngVar)) <> 0 Then
ReDim Preserve dblVals(0 To lngCnt)
dblVals(lngCnt) = CDbl(varArr(lngVar))
lngCnt = lngCnt + 1
End If
End If
Next lngVar
ZahlenFilter = dblVals
End Function
'Statistical Functions
Public Function Anzahl(ParamArray varVals() As Variant) As Long
Anzahl = UBound(ZahlenFilter(varVals)) + 1
End Function
Public Function GeometrischesMittel(ParamArray varVals() As Variant) As Variant
Dim lngUB As Long, lngVar As Long
Dim dblGeo As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
dblGeo = 1
For lngVar = 0 To lngUB
If varArr(lngVar) < 0 Then
GeometrischesMittel = Null
Exit Function
End If
dblGeo = dblGeo * varArr(lngVar)
Next lngVar
GeometrischesMittel = dblGeo ^ (1 / (lngUB + 1))
End Function
Public Function Haeufigkeit(ByVal dblVal As Double, ParamArray varVals() As Variant) As Long
Dim lngUB As Long, lngVar As Long, lngCnt As Long
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 1 To lngUB
If varArr(lngVar) = dblVal Then lngCnt = lngCnt + 1
Next lngVar
Haeufigkeit = lngCnt
End Function
Public Function Maximum(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblMax As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
dblMax = varArr(0)
For lngVar = 1 To lngUB
If varArr(lngVar) > dblMax Then dblMax = varArr(lngVar)
Next lngVar
Maximum = dblMax
End Function
Public Function Median(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar1 As Long, lngVar2 As Long
Dim dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar1 = 0 To lngUB - 1
For lngVar2 = lngVar1 + 1 To lngUB
If varArr(lngVar1) > varArr(lngVar2) Then
dblVar = varArr(lngVar1)
varArr(lngVar1) = varArr(lngVar2)
varArr(lngVar2) = dblVar
End If
Next lngVar2
Next lngVar1
If lngUB Mod 2 Then
Median = (varArr((lngUB - 1) \ 2) + varArr((lngUB - 1) \ 2 + 1)) / 2
Else
Median = varArr(lngUB \ 2)
End If
End Function
Public Function Minimum(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblMin As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
dblMin = varArr(0)
For lngVar = 1 To lngUB
If varArr(lngVar) < dblMin Then dblMin = varArr(lngVar)
Next lngVar
Minimum = dblMin
End Function
Public Function MittelAbweichung(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblAvg As Double, dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 0 To lngUB
dblAvg = dblAvg + varArr(lngVar)
Next lngVar
dblAvg = dblAvg / (lngUB + 1)
For lngVar = 0 To lngUB
dblVar = dblVar + Abs(varArr(lngVar) - dblAvg)
Next lngVar
MittelAbweichung = dblVar / (lngUB + 1)
End Function
Public Function Mittelwert(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblAvg As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 0 To lngUB
dblAvg = dblAvg + varArr(lngVar)
Next lngVar
Mittelwert = dblAvg / (lngUB + 1)
End Function
Public Function Modalwert(ParamArray varVals() As Variant) As Variant
Dim lngUB As Long, lngVar1 As Long, lngVar2 As Long, lngCnts() As Long
Dim dblMdl As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
ReDim lngCnts(0 To lngUB)
For lngVar1 = 0 To lngUB - 1
For lngVar2 = lngVar1 + 1 To lngUB
If varArr(lngVar1) = varArr(lngVar2) Then lngCnts(lngVar1) = lngCnts(lngVar1) + 1
Next lngVar2
Next lngVar1
lngVar1 = 0
For lngVar2 = 1 To lngUB
If lngCnts(lngVar1) < lngCnts(lngVar2) Then lngVar1 = lngVar2
Next lngVar2
For lngVar2 = 0 To lngUB
If lngVar2 <> lngVar1 And lngCnts(lngVar2) = lngCnts(lngVar1) Then
Modalwert = Null
Exit Function
End If
Next lngVar2
Modalwert = varArr(lngVar1)
End Function
Public Function Produkt(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
dblVar = 1
For lngVar = 0 To lngUB
dblVar = dblVar * varArr(lngVar)
Next lngVar
Produkt = dblVar
End Function
Public Function QuadratMittel(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 0 To lngUB
dblVar = dblVar + varArr(lngVar) ^ 2
Next lngVar
QuadratMittel = Sqr(dblVar / (lngUB + 1))
End Function
Public Function Summe(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 0 To lngUB
dblVar = dblVar + varArr(lngVar)
Next lngVar
Summe = dblVar
End Function
Public Function Varianz(ParamArray varVals() As Variant) As Double
Dim lngUB As Long, lngVar As Long
Dim dblAvg As Double, dblVar As Double
Dim varArr As Variant
varArr = ZahlenFilter(varVals)
lngUB = UBound(varArr)
For lngVar = 0 To lngUB
dblAvg = dblAvg + varArr(lngVar)
Next lngVar
dblAvg = dblAvg / (lngUB + 1)
For lngVar = 0 To lngUB
dblVar = dblVar + (varArr(lngVar) - dblAvg) ^ 2
Next lngVar
Varianz = dblVar / (lngUB + 1)
End Function