求解多元一次方程组:
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