Загрузка данных


Sub SolveQuadraticEquation()
    ' Объявление переменных для коэффициентов и корней
    Dim a As Double, b As Double, c As Double
    Dim D As Double, x1 As Double, x2 As Double
    Dim inputA As String, inputB As String, inputC As String

    ' Ввод коэффициентов с клавиатуры через InputBox
    inputA = InputBox("Введите коэффициент a:", "Ввод данных")
    inputB = InputBox("Введите коэффициент b:", "Ввод данных")
    inputC = InputBox("Введите коэффициент c:", "Ввод данных")

    ' Проверка на пустой ввод или отмену
    If inputA = "" Or inputB = "" Or inputC = "" Then
        MsgBox "Ошибка: Все коэффициенты должны быть введены!", vbCritical, "Ошибка"
        Exit Sub
    End If

    ' Преобразование строкового ввода в числа
    a = Val(inputA)
    b = Val(inputB)
    c = Val(inputC)

    ' --- АНАЛИЗ ЧАСТНЫХ СЛУЧАЕВ ПО МЕТОДИЧКЕ ---

    ' 1. Случай: a=0, b=0, c=0
    If a = 0 And b = 0 And c = 0 Then
        MsgBox "Уравнение вида 0=0. Тождество. Х — любое число (бесконечное множество решений).", vbInformation, "Результат"
        Exit Sub
    
    ' 2. Случай: b=0, c=0 (а не равно 0, так как предыдущее условие ложно)
    ElseIf b = 0 And c = 0 Then
        MsgBox "Уравнение вида a*x^2 = 0. Единственный корень: x = 0", vbInformation, "Результат"
        Exit Sub
        
    ' 3. Случай: a=0, b=0 (с не равно 0)
    ElseIf a = 0 And b = 0 Then
        MsgBox "Уравнение вида " & c & " = 0. Неверное равенство. Решений нет.", vbExclamation, "Результат"
        Exit Sub
        
    ' 4. Случай: a=0, c=0 (b не равно 0)
    ElseIf a = 0 And c = 0 Then
        MsgBox "Уравнение вырождается в линейное вида b*x = 0. Единственный корень: x = 0", vbInformation, "Результат"
        Exit Sub
        
    ' 5. Случай: a=0 (уравнение становится линейным: b*x + c = 0)
    ElseIf a = 0 Then
        x1 = -c / b
        MsgBox "Старший коэффициент a=0. Уравнение линейное. Единственный корень: x = " & x1, vbInformation, "Результат"
        Exit Sub
        
    ' 6. Случай: b=0 (неполное квадратное: a*x^2 + c = 0)
    ElseIf b = 0 Then
        If -c / a >= 0 Then
            x1 = Sqr(-c / a)
            x2 = -Sqr(-c / a)
            MsgBox "Неполное квадратное уравнение (b=0)." & vbCrLf & _
                   "Корень x1 = " & x1 & vbCrLf & _
                   "Корень x2 = " & x2, vbInformation, "Результат"
        Else
            MsgBox "Неполное квадратное уравнение (b=0). Под коренное выражение меньше нуля. Действительных корней нет.", vbExclamation, "Результат"
        End If
        Exit Sub
        
    ' 7. Случай: c=0 (неполное квадратное: a*x^2 + b*x = 0 -> x*(a*x + b) = 0)
    ElseIf c = 0 Then
        x1 = 0
        x2 = -b / a
        MsgBox "Неполное квадратное уравнение (c=0)." & vbCrLf & _
               "Корень x1 = " & x1 & vbCrLf & _
               "Корень x2 = " & x2, vbInformation, "Результат"
        Exit Sub
    End If


    ' --- СТАНДАРТНОЕ РЕШЕНИЕ (Когда все коэффициенты отличны от нуля) ---
    
    ' Вычисление дискриминанта по формуле из Рис. 1 методички: D = b^2 - 4ac
    D = (b ^ 2) - (4 * a * c)

    ' Анализ дискриминанта
    If D > 0 Then
        ' Два корня
        x1 = (-b + Sqr(D)) / (2 * a)
        x2 = (-b - Sqr(D)) / (2 * a)
        MsgBox "Дискриминант D = " & D & " (D > 0)." & vbCrLf & _
               "Уравнение имеет два корня:" & vbCrLf & _
               "x1 = " & x1 & vbCrLf & _
               "x2 = " & x2, vbInformation, "Результат"
               
    ElseIf D = 0 Then
        ' Один корень
        x1 = -b / (2 * a)
        MsgBox "Дискриминант D = 0." & vbCrLf & _
               "Уравнение имеет один корень:" & vbCrLf & _
               "x = " & x1, vbInformation, "Результат"
               
    Else
        ' Корней нет (D < 0)
        MsgBox "Дискриминант D = " & D & " (D < 0)." & vbCrLf & _
               "Вещественных корней нет.", vbExclamation, "Результат"
    End If

End Sub