用VB 写的求解多元线性方程组的程序
使用时将方程组的系数矩阵和常数矩阵输入一EXCEL 工作表 最后将结果也输出到该表格内
如上图，对应的方程组为:
2X+3Y+Z=4
4X+2Y+3Z=17
7X+Y-Z=1
系数矩阵在SHEET1中输入，常数矩阵在SHEET2第一列中输入
求解结果在SHEET2第三列输出
在工程中需添加以下两个控件
简陋的界面如下:
未知数的个数与系数矩阵的行数对应
以下为代码
‘通用部分输入以下代码
Option Base 1
Dim xlApp As Excel.Application '定义EXCEL 类
Dim xlBook As Excel.Workbook '定义工作簿类
Dim xlSheet As Excel.Worksheet '定义工作表类
Dim M, N, p As Integer
Dim A(), mtxA(), C() As Double
‘按键一单机事件输入
Private Sub CMDOPEN_Click()
‘从EXCEL 文件中导入方程组系数矩阵的数据
‘从Sheet1左上角开始输入，一个单元格输入一个系数，一行输入一‘个方程
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
CD1.ShowOpen
Set xlBook = xlApp.Workbooks.Open(CD1.FileName)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Activate
xlApp.Caption = "VB程序正在调用该文件"
'-----------------
M = Text1.Text
N = M
p = 1
ReDim mtxA(M, N)
ReDim B(N, p)
ReDim C(M, p)
' 读系数矩阵
For i = 1 To M
For j = 1 To N
mtxA(i, j) = xlSheet.Cells(i, j)
Next j
Next i
' 矩阵求逆
t = MRinv(Int(M))
' 读常量矩阵
‘从Sheet2左上角开始，一单元格输入一个系数，一行输入一个Set xlSheet = xlBook.Worksheets(2)
xlSheet.Activate
For i = 1 To M
B(i, 1) = xlSheet.Cells(i, 1)
Next i
' 矩阵相乘
For i = 1 To M
For j = 1 To p
C(i, j) = 0
For k = 1 To N
C(i, j) = mtxA(i, k) * B(k, j) + C(i, j)
Next k
Next j
Next i
‘结果输出
For i = 1 To M
xlSheet.Cells(i, 3) = C(i, 1)
Next i
End Sub
‘系数矩阵求逆的函数(参考下面网址)
Function MRinv(N As Integer) As Boolean
ReDim nIs(N) As Integer, nJs(N) As Integer
Dim i As Integer, j As Integer, k As Integer
Dim D As Double, p As Double
' 全选主元，消元
For k = 1 To N
D = 0#
For i = k To N
For j = k To N
p = Abs(mtxA(i, j))
If (p > D) Then
D = p
nIs(k) = i
nJs(k) = j
End If
Next j
Next i
' 求解失败
If (D + 1# = 1#) Then
MRinv = False
Exit Function
End If
If (nIs(k) k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nIs(k), j)
mtxA(nIs(k), j) = p
Next j
End If
If (nJs(k) k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nJs(k))
mtxA(i, nJs(k)) = p
Next i
End If
mtxA(k, k) = 1# / mtxA(k, k)
For j = 1 To N
If (j k) Then mtxA(k, j) = mtxA(k, j) * mtxA(k, k)
Next j
For i = 1 To N
If (i k) Then
For j = 1 To N
If (j k) Then mtxA(i, j) = mtxA(i, j) - mtxA(i, k) * mtxA(k, j)
Next j
End If
Next i
For i = 1 To N
If (i k) Then mtxA(i, k) = -mtxA(i, k) * mtxA(k, k) Next i
Next k
' 调整恢复行列次序
For k = N To 1 Step -1
If (nJs(k) k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nJs(k), j)
mtxA(nJs(k), j) = p
Next j
End If
If (nIs(k) k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nIs(k))
mtxA(i, nIs(k)) = p
Next i
End If
Next k
' 求解成功 MRinv = True End Function
用VB 写的求解多元线性方程组的程序
使用时将方程组的系数矩阵和常数矩阵输入一EXCEL 工作表 最后将结果也输出到该表格内
如上图，对应的方程组为:
2X+3Y+Z=4
4X+2Y+3Z=17
7X+Y-Z=1
系数矩阵在SHEET1中输入，常数矩阵在SHEET2第一列中输入
求解结果在SHEET2第三列输出
在工程中需添加以下两个控件
简陋的界面如下:
未知数的个数与系数矩阵的行数对应
以下为代码
‘通用部分输入以下代码
Option Base 1
Dim xlApp As Excel.Application '定义EXCEL 类
Dim xlBook As Excel.Workbook '定义工作簿类
Dim xlSheet As Excel.Worksheet '定义工作表类
Dim M, N, p As Integer
Dim A(), mtxA(), C() As Double
‘按键一单机事件输入
Private Sub CMDOPEN_Click()
‘从EXCEL 文件中导入方程组系数矩阵的数据
‘从Sheet1左上角开始输入，一个单元格输入一个系数，一行输入一‘个方程
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
CD1.ShowOpen
Set xlBook = xlApp.Workbooks.Open(CD1.FileName)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Activate
xlApp.Caption = "VB程序正在调用该文件"
'-----------------
M = Text1.Text
N = M
p = 1
ReDim mtxA(M, N)
ReDim B(N, p)
ReDim C(M, p)
' 读系数矩阵
For i = 1 To M
For j = 1 To N
mtxA(i, j) = xlSheet.Cells(i, j)
Next j
Next i
' 矩阵求逆
t = MRinv(Int(M))
' 读常量矩阵
‘从Sheet2左上角开始，一单元格输入一个系数，一行输入一个Set xlSheet = xlBook.Worksheets(2)
xlSheet.Activate
For i = 1 To M
B(i, 1) = xlSheet.Cells(i, 1)
Next i
' 矩阵相乘
For i = 1 To M
For j = 1 To p
C(i, j) = 0
For k = 1 To N
C(i, j) = mtxA(i, k) * B(k, j) + C(i, j)
Next k
Next j
Next i
‘结果输出
For i = 1 To M
xlSheet.Cells(i, 3) = C(i, 1)
Next i
End Sub
‘系数矩阵求逆的函数(参考下面网址)
Function MRinv(N As Integer) As Boolean
ReDim nIs(N) As Integer, nJs(N) As Integer
Dim i As Integer, j As Integer, k As Integer
Dim D As Double, p As Double
' 全选主元，消元
For k = 1 To N
D = 0#
For i = k To N
For j = k To N
p = Abs(mtxA(i, j))
If (p > D) Then
D = p
nIs(k) = i
nJs(k) = j
End If
Next j
Next i
' 求解失败
If (D + 1# = 1#) Then
MRinv = False
Exit Function
End If
If (nIs(k) k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nIs(k), j)
mtxA(nIs(k), j) = p
Next j
End If
If (nJs(k) k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nJs(k))
mtxA(i, nJs(k)) = p
Next i
End If
mtxA(k, k) = 1# / mtxA(k, k)
For j = 1 To N
If (j k) Then mtxA(k, j) = mtxA(k, j) * mtxA(k, k)
Next j
For i = 1 To N
If (i k) Then
For j = 1 To N
If (j k) Then mtxA(i, j) = mtxA(i, j) - mtxA(i, k) * mtxA(k, j)
Next j
End If
Next i
For i = 1 To N
If (i k) Then mtxA(i, k) = -mtxA(i, k) * mtxA(k, k) Next i
Next k
' 调整恢复行列次序
For k = N To 1 Step -1
If (nJs(k) k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nJs(k), j)
mtxA(nJs(k), j) = p
Next j
End If
If (nIs(k) k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nIs(k))
mtxA(i, nIs(k)) = p
Next i
End If
Next k
' 求解成功 MRinv = True End Function