VBA - MATHEMATISCHE FUNKTIONEN

Const pi = 3.141592654

Public Function KREIS_FLÄCHE(Optional Radius, Optional Durchmesser)
If Not IsMissing(Radius) Then
    KREIS_FLÄCHE = Durchmesser * pi
End If
If Not IsMissing(Durchmesser) Then
    KREIS_FLÄCHE = Radius ^ 2 * pi
End If
End Function

Public Function KUGEL_FLÄCHE(Optional Radius, Optional Durchmesser) As Double
If Not IsMissing(Radius) Then
    KUGEL_FLÄCHE = Durchmesser ^ 2 * pi
End If
If Not IsMissing(Durchmesser) Then
    KUGEL_FLÄCHE = Radius * 2 ^ 2 * pi
End If
End Function

Public Function KUGEL_GEWICHT(SpezGewicht As Double, Radius As Double) As Double
KUGEL_GEWICHT = KUGEL_VOLUMEN(Radius) * SpezGewicht
End Function

Public Function KUGEL_INHALT(Optional Radius, Optional Durchmesser) As Double
If Not IsMissing(Radius) Then
    KUGEL_INHALT = Radius ^ 3 * pi
Else
    KUGEL_INHALT = Durchmesser / 2 ^ 3 * pi
End If
End Function


Public Function KUGEL_VOLUMEN(Optional Radius, Optional Durchmesser) As Double
If Not IsMissing(Radius) Then
    KUGEL_VOLUMEN = 4 / 3 * pi * Radius ^ 3
Else
    KUGEL_VOLUMEN = 4 / 3 * pi * Durchmesser / 2 ^ 3
End If
End Function

Public Function QUADER_FLÄCHE(ParamArray QW()) As Double
Dim QAnzahl As Double
QAnzahl = UBound(QW) + 1
If QAnzahl > 3 Then QAnzahl = 3
Select Case QAnzahl
    Case 3
        QUADER_FLÄCHE = (QW(0) * QW(1) + QW(1) * QW(2) + QW(0) * QW(2)) * 2
    Case 2
        QUADER_FLÄCHE = (QW(0) * QW(1) * 2 + QW(1) ^ 2) * 2
    Case 1
        QUADER_FLÄCHE = QW(0) ^ 2 * 6
End Select
End Function

Public Function QUADER_GEWICHT(ParamArray QWerte()) As Double
Dim QAnzahl As Integer
Dim SpezG As Double
QAnzahl = UBound(QWerte) + 1
SpezG = QWerte(0) ' Erster Wert = spezifisches Gewicht
If QAnzahl > 4 Then QAnzahl = 4
Select Case QAnzahl
    Case 4
        QUADER_GEWICHT = SpezG * QUADER_INHALT(QWerte(1), QWerte(2), QWerte(3))
    Case 3
        QUADER_GEWICHT = SpezG * QUADER_INHALT(QWerte(1), QWerte(2))
    Case 2
        QUADER_GEWICHT = SpezG * QWerte(1) ^ 3
    Case 1
        QUADER_GEWICHT = SpezG ^ 4
End Select
End Function

Public Function QUADER_INHALT(ParamArray QWerte()) As Double
Dim QAnzahl, I As Integer
QAnzahl = UBound(QWerte) + 1
Select Case QAnzahl
    Case 3
        QUADER_INHALT = QWerte(0) * QWerte(1) * QWerte(2)
    Case 2
        QUADER_INHALT = QWerte(0) * QWerte(1) ^ 2
    Case 1
        QUADER_INHALT = QWerte(0) ^ 3
End Select
End Function

Public Function RECHTECK_FLÄCHE(ParamArray QWerte()) As Double
Dim QAnzahl, I As Integer
QAnzahl = UBound(QWerte) + 1
If QAnzahl > 2 Then QAnzahl = 2
Select Case QAnzahl
    Case 2
        RECHTECK_FLÄCHE = QWerte(0) * QWerte(1)
    Case 1
        RECHTECK_FLÄCHE = QWerte(0) ^ 2
End Select
End Function

Public Function WÜRFEL_FLÄCHE(Seite As Double) As Double
WÜRFEL_FLÄCHE = Seite ^ 2 * 6
End Function

Public Function WÜRFEL_INHALT(Seite As Double) As Double
WÜRFEL_INHALT = Seite ^ 3
End Function

Public Function WÜRFEL_GEWICHT(Seite, SpezGewicht As Double) As Double
WÜRFEL_GEWICHT = Seite ^ 3 * SpezGewicht
End Function

Public Function SUMME(ParamArray W()) As Double
' Summierung einer beliebig langen Wertereihe
Dim I, SM As Double
SM = 0
For I = 0 To UBound(W)
    SM = SM + W(I)
Next I
SUMME = SM ' Übergabe der Summierung an Funktion SUMME
End Function


Public Function MITTELWERT(ParamArray W()) As Double
' Summierung einer beliebig langen Wertereihe
Dim I, WAnzahl As Integer
Dim SM As Double
SM = 0
WAnzahl = UBound(W) ' Anzahl der Elemente
For I = 0 To WAnzahl
    SM = SM + W(I)
Next I
MITTELWERT = SM / (WAnzahl + 1) ' Ermittlung des Mittelwertes
End Function