VB求解多元线性方程组的程序.docx
- 文档编号:8379589
- 上传时间:2023-01-30
- 格式:DOCX
- 页数:9
- 大小:138.49KB
VB求解多元线性方程组的程序.docx
《VB求解多元线性方程组的程序.docx》由会员分享,可在线阅读,更多相关《VB求解多元线性方程组的程序.docx(9页珍藏版)》请在冰豆网上搜索。
VB求解多元线性方程组的程序
用VB写的求解多元线性方程组的程序
使用时将方程组的系数矩阵和常数矩阵输入一EXCEL工作表
最后将结果也输出到该表格内
如上图,对应的方程组为:
2X+3Y+Z=4
4X+2Y+3Z=17
7X+Y-Z=1
系数矩阵在SHEET1中输入,常数矩阵在SHEET2第一列中输入
求解结果在SHEET2第三列输出
在工程中需添加以下两个控件
简陋的界面如下:
未知数的个数与系数矩阵的行数对应
以下为代码
‘通用部分输入以下代码
OptionBase1
DimxlAppAsExcel.Application'定义EXCEL类
DimxlBookAsExcel.Workbook'定义工作簿类
DimxlSheetAsExcel.Worksheet'定义工作表类
DimM,N,pAsInteger
DimA(),mtxA(),C()AsDouble
‘按键一单机事件输入
PrivateSubCMDOPEN_Click()
‘从EXCEL文件中导入方程组系数矩阵的数据
‘从Sheet1左上角开始输入,一个单元格输入一个系数,一行输入一
‘个方程
SetxlApp=CreateObject("Excel.Application")
xlApp.Visible=True
CD1.ShowOpen
SetxlBook=xlApp.Workbooks.Open(CD1.FileName)
SetxlSheet=xlBook.Worksheets
(1)
xlSheet.Activate
xlApp.Caption="VB程序正在调用该文件"
'-----------------
M=Text1.Text
N=M
p=1
ReDimmtxA(M,N)
ReDimB(N,p)
ReDimC(M,p)
'读系数矩阵
Fori=1ToM
Forj=1ToN
mtxA(i,j)=xlSheet.Cells(i,j)
Nextj
Nexti
'矩阵求逆
t=MRinv(Int(M))
'读常量矩阵
‘从Sheet2左上角开始,一单元格输入一个系数,一行输入一个
SetxlSheet=xlBook.Worksheets
(2)
xlSheet.Activate
Fori=1ToM
B(i,1)=xlSheet.Cells(i,1)
Nexti
'矩阵相乘
Fori=1ToM
Forj=1Top
C(i,j)=0
Fork=1ToN
C(i,j)=mtxA(i,k)*B(k,j)+C(i,j)
Nextk
Nextj
Nexti
‘结果输出
Fori=1ToM
xlSheet.Cells(i,3)=C(i,1)
Nexti
EndSub
‘系数矩阵求逆的函数(参考下面网址)
FunctionMRinv(NAsInteger)AsBoolean
ReDimnIs(N)AsInteger,nJs(N)AsInteger
DimiAsInteger,jAsInteger,kAsInteger
DimDAsDouble,pAsDouble
'全选主元,消元
Fork=1ToN
D=0#
Fori=kToN
Forj=kToN
p=Abs(mtxA(i,j))
If(p>D)Then
D=p
nIs(k)=i
nJs(k)=j
EndIf
Nextj
Nexti
'求解失败
If(D+1#=1#)Then
MRinv=False
ExitFunction
EndIf
If(nIs(k)<>k)Then
Forj=1ToN
p=mtxA(k,j)
mtxA(k,j)=mtxA(nIs(k),j)
mtxA(nIs(k),j)=p
Nextj
EndIf
If(nJs(k)<>k)Then
Fori=1ToN
p=mtxA(i,k)
mtxA(i,k)=mtxA(i,nJs(k))
mtxA(i,nJs(k))=p
Nexti
EndIf
mtxA(k,k)=1#/mtxA(k,k)
Forj=1ToN
If(j<>k)ThenmtxA(k,j)=mtxA(k,j)*mtxA(k,k)
Nextj
Fori=1ToN
If(i<>k)Then
Forj=1ToN
If(j<>k)ThenmtxA(i,j)=mtxA(i,j)-mtxA(i,k)*mtxA(k,j)
Nextj
EndIf
Nexti
Fori=1ToN
If(i<>k)ThenmtxA(i,k)=-mtxA(i,k)*mtxA(k,k)
Nexti
Nextk
'调整恢复行列次序
Fork=NTo1Step-1
If(nJs(k)<>k)Then
Forj=1ToN
p=mtxA(k,j)
mtxA(k,j)=mtxA(nJs(k),j)
mtxA(nJs(k),j)=p
Nextj
EndIf
If(nIs(k)<>k)Then
Fori=1ToN
p=mtxA(i,k)
mtxA(i,k)=mtxA(i,nIs(k))
mtxA(i,nIs(k))=p
Nexti
EndIf
Nextk
'求解成功
MRinv=True
EndFunction
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 求解 多元 线性方程组 程序