Question

怎么用VB解多元一次方程组

Answer 1

Public Function 解方程(增广矩阵() As Single, 解() As Single) As Boolean
    Dim n As Integer, m As Integer, k As Integer, w As Single, 矩阵() As Single
    Dim i As Integer, j As Integer
    n = UBound(增广矩阵, 1)
    m = UBound(增广矩阵, 2)
    k = UBound(解)
    If n <> k Or n + 1 <> m Then
        MsgBox "增广矩阵的行列不匹配，或者与结果绝阵行数不匹配。", vbExclamation
        解方程 = False
        Exit Function
    End If
    ReDim 矩阵(n, m)
    For i = 0 To n
        For j = 0 To m
            矩阵(i, j) = 增广矩阵(i, j)
        Next j
    Next i
    
    For i = 0 To n
        For j = i + 1 To n
            If Abs(矩阵(i, i)) < Abs(矩阵(j, i)) Then
                For k = i To n + 1
                    w = 矩阵(i, k)
                    矩阵(i, k) = 矩阵(j, k)
                    矩阵(j, k) = w
                Next k
            End If
        Next j
        If 矩阵(i, i) = 0 Then
            MsgBox "至少存在一组同构方程，该组方程无定解。", vbExclamation
            解方程 = False
            Exit Function
        End If
        For j = i + 1 To m
            矩阵(i, j) = 矩阵(i, j) / 矩阵(i, i)
        Next j
        矩阵(i, i) = 1
        For j = i + 1 To n
            w = 矩阵(j, i)
            For k = i To m
                矩阵(j, k) = 矩阵(j, k) - 矩阵(i, k) * w
            Next k
        Next j
    Next i
    For i = n To 0 Step -1
        w = 0
        For j = i + 1 To n
            w = w + 矩阵(i, j) * 解(j)
        Next j
        解(i) = (矩阵(i, m) - w) / 矩阵(i, i)
    Next i
    解方程 = True
 End Function
 
Private Sub Command1_Click()
    Dim n As Integer, a() As Single, x() As Single
    n = InputBox("请输入方程组元数（未知数个数n）")
    ReDim a(n - 1, n)
    ReDim x(n - 1)
    Print "给定方程组的增广矩阵为："
    For i = 0 To n - 1
        For j = 0 To n
            a(i, j) = InputBox("输入系数矩阵A(" & i + 1 & "," & j + 1 & ")")
            Print a(i, j);
        Next j
        Print
    Next i
    If 解方程(a(), x()) Then
        For k = 0 To n - 1
            Print "x("; k + 1; ")"; "="; x(k)
        Next k
    End If
End Sub


Private Sub Form_Load()
    Me.AutoRedraw = True
End Sub