XProfan

Attribute VB_Name = "modQuadratischeGleichung"
-------------------------------------------------------------------------------------
modQuadratischeGleichung.bas
-------------------------------------------------------------------------------------
Autor: Tobias Fröhlich
eMail: tobias-froehlich@gmx.net
www:   www.tobias-froehlich.de
-------------------------------------------------------------------------------------
Funktion:
Berechnet die Nullstellen einer quadratischen Gleichung der Form
0 = ax² + bx + c
-------------------------------------------------------------------------------------
Rückgabewerte:
"keine Lösung" - Es existieren keinerlei Nullstellen
"1|x1"         - Es existiert eine Nullstelle
"2|x1|x2"      - Es existieren zwei Nullstellen
"unendl."      - Es existieren unendlich viele Nullstellen
-------------------------------------------------------------------------------------
Beispiel:
Temp = QuadratischeGleichung(4,8,-20)
Temp = Split(Temp,"|")
MsgBox Temp(0),vbOKOnly,"Anzahl der Lösungen:"
MsgBox Temp(1),vbOKOnly,"x1:"
MsgBox Temp(2),vbOKOnly,"x2:"
-------------------------------------------------------------------------------------
Public Function QuadratischeGleichung(a As Single, b As Single, c As Single) As String
On Error GoTo QuadratischeGleichung_Fehler
Dim d As Single
Dim QuadratischeGleichung_Result As String
d = b ^ 2 - 4 * a * c

If a <> 0 Then

    If d < 0 Then

        QuadratischeGleichung_Result = "keine Lösung"
        End If

        If d = 0 Then

            QuadratischeGleichung_Result = "1|" & Format$((-b / (2 * a)), "####0.000")
            End If

            If d > 0 Then

                QuadratischeGleichung_Result = "2|" & Format$((-b + Sqr(d)) / (2 * a), "####0.000") & "|" & Format$((-b - Sqr(d)) / (2 * a), "####0.000")
                End If

            Else

                If b <> 0 Then

                    QuadratischeGleichung_Result = "1|" & -c / b

                Else

                    If c = 0 Then

                        QuadratischeGleichung_Result = "unendl."

                    Else

                        QuadratischeGleichung_Result = "keine Lösung"
                        End If
                        End If
                        End If
                        GoTo QuadratischeGleichung_OK
                        QuadratischeGleichung_Fehler:
                        MsgBox "Im Modul QuadratischeGleichung ist ein Fehler aufgetreten!", vbCritical
                        Exit Function
                        QuadratischeGleichung_OK:
                        QuadratischeGleichung = QuadratischeGleichung_Result
                        End Function