多元一次方程组的求解

求解多元一次方程组：

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

  End Sub

 返回：

X1=   0.83
X2=   3.04
X3=   2.13