VB求解多元线性方程组的程序Word格式文档下载.docx

VB求解多元线性方程组的程序Word格式文档下载.docx

《VB求解多元线性方程组的程序Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《VB求解多元线性方程组的程序Word格式文档下载.docx（9页珍藏版）》请在冰豆网上搜索。

在工程中需添加以下两个控件

简陋的界面如下:

未知数的个数与系数矩阵的行数对应

以下为代码

‘通用部分输入以下代码

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）

B（i,1）=xlSheet.Cells（i,1）

矩阵相乘

Forj=1Top

C（i,j）=0

Fork=1ToN

C（i,j）=mtxA（i,k）*B（k,j）+C（i,j）

Nextk

‘结果输出

xlSheet.Cells（i,3）=C（i,1）

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

Nexti

'

求解失败

If（D+1#=1#）Then

MRinv=False

ExitFunction

If（nIs（k）<

>

k）Then

p=mtxA（k,j）

mtxA（k,j）=mtxA（nIs（k）,j）

mtxA（nIs（k）,j）=p

If（nJs（k）<

Fori=1ToN

p=mtxA（i,k）

mtxA（i,k）=mtxA（i,nJs（k））

mtxA（i,nJs（k））=p

mtxA（k,k）=1#/mtxA（k,k）

If（j<

k）ThenmtxA（k,j）=mtxA（k,j）*mtxA（k,k）

If（i<

k）ThenmtxA（i,j）=mtxA（i,j）-mtxA（i,k）*mtxA（k,j）

k）ThenmtxA（i,k）=-mtxA（i,k）*mtxA（k,k）

Nextk

调整恢复行列次序

Fork=NTo1Step-1

mtxA（k,j）=mtxA（nJs（k）,j）

mtxA（nJs（k）,j）=p

mtxA（i,k）=mtxA（i,nIs（k））

mtxA（i,nIs（k））=p

求解成功

MRinv=True

EndFunction