求解多元一次方程组-优快云博客

本文链接：https://blog.youkuaiyun.com/northwolves/article/details/1365278

求解多元一次方程组：

f(1,1)x1+f(1,2)x2+f(1,3)x3+...=f(1,n)

f(2,1)x1+f(2,2)x2+f(2,3)x3+...=f(2,n)

f(3,1)x1+f(3,2)x2+f(3,3)x3+...=f(3,n)

......

f(m,1)x1+f(m,2)x2+f(m,3)x3+...=f(m,n)

采用高斯消元法：

Option Base 1
Function Determinant(ByRef factor) As Single
            Dim i     As Long, j       As Long, k       As Long, row       As Long, order       As Long
            Dim r     As Long, c       As Long, Pivot       As Single, Pivot2       As Single, temp()       As Single
            Determinant = 1
            Dim m

            m = factor
            row = UBound(m, 1)
            If Not UBound(m, 2) = row + 1 Then MsgBox "无解或不定解！":                       Exit Function
            ReDim temp(1 To row)

            For i = 1 To row

                      Pivot = 0
                      For j = i To row
                                For k = i To row
                                          If Abs(m(k, j)) > Pivot Then
                                                    Pivot = Abs(m(k, j))
                                                    r = k:       c = j
                                          End If
                                Next k
                      Next j

                      If Pivot = 0 Then Determinant = 0:                 Exit Function

                      If r <> i Then
                                order = order + 1
                                For j = 1 To row
                                          temp(j) = m(i, j)
                                          m(i, j) = m(r, j)
                                          m(r, j) = temp(j)
                                Next j
                      End If

                      If c <> i Then
                                order = order + 1
                                For j = 1 To row
                                          temp(j) = m(j, i)
                                          m(j, i) = m(j, c)
                                          m(j, c) = temp(j)
                                Next j
                      End If

                      Pivot = m(i, i)
                      Determinant = Determinant * Pivot

                      For j = i + 1 To row
                                Pivot2 = m(j, i)
                                If Pivot2 <> 0 Then
                                          For k = 1 To row
                                                    m(j, k) = m(j, k) - m(i, k) * Pivot2 / Pivot
                                          Next
                                End If
                      Next

            Next

            Determinant = Determinant * (-1) ^ order
End Function

Sub getresult(ByRef factor(), ByRef answer As String)
Dim row     As Integer, i       As Integer, D0       As Single
Dim m
Dim result()     As String
row = UBound(factor, 1)
ReDim result(1 To row)
D0 = Determinant(factor)
If D0 = 0 Then MsgBox "无解！":               Exit Sub
For i = 1 To row
    m = factor
For j = 1 To row
m(j, i) = factor(j, row + 1)
Next
result(i) = "X" & i & "=   " & Format(Determinant(m) / D0, "0.00")                         '   Di/D0
Next
answer = Join(result, vbCrLf)
End Sub

Private Sub Command1_Click()
Dim Param(3, 4)       '   三元一次方程组
Dim i     As Integer
For i = 1 To 4
Param(1, i) = Choose(i, 1, 1, 1, 6)                   '   x1+x2+x3=6
Param(2, i) = Choose(i, 2, -1, 3, 5)                 '   2x1-x2+3x3=5
Param(3, i) = Choose(i, 4, 2, -3, 3)                   '4x1+2x2-3x3=3
Next
Dim answer     As String
getresult Param, answer
Debug.Print answer