vb逆矩阵的求法.docx
《vb逆矩阵的求法.docx》由会员分享，可在线阅读，更多相关《vb逆矩阵的求法.docx（7页珍藏版）》请在冰豆网上搜索。
vb逆矩阵的求法
逆矩阵的求法
设
是一个三阶方阵，如果存在三阶方阵B满足AB=E，E是三阶单位矩阵，那么B称为A的逆矩阵，记为
。
求矩阵A的逆矩阵
可以用初等变换，也可以用公式.
1,公式法
矩阵A的逆
可由公式1求得
（公式1）
在公式1中分母
是矩阵A的行列式，分子
是矩阵A的伴随矩阵。
矩阵的A的行列式
可由公式2得到
（公式2）
矩阵A的伴随矩阵
由下列公式3给出
（公式3）
在如公式3中所示的伴随矩阵
的每个元素计算公式如公式4所示，
（公式4）
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模块名：
MatrixModule.bas
' 函数名：
MCinv
' 功能：
实矩阵求逆的全选主元高斯－约当法
' 参数：
n - Integer型变量，矩阵的阶数
' mtxAR - Double型二维数组，体积为n x n。
存放原矩阵A的实部；返回时存放其逆矩阵A-的实部。
' mtxAI - Double型二维数组，体积为n x n。
存放原矩阵A的虚部；返回时存放其逆矩阵A-的虚部。
' 返回值：
Boolean型，失败为False，成功为True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MCinv（n As Integer, mtxAR（） As Double, mtxAI（） As Double） 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, s As Double, t As Double, q As Double, b As Double
' 全选主元，消元
For k = 1 To n
d = 0#
For i = k To n
For j = k To n
p = mtxAR（i, j） * mtxAR（i, j） + mtxAI（i, j） * mtxAI（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
MCinv = False
Exit Function
End If
If （nIs（k） <> k） Then
For j = 1 To n
t = mtxAR（k, j）
mtxAR（k, j） = mtxAR（nIs（k）, j）
mtxAR（nIs（k）, j） = t
t = mtxAI（k, j）
mtxAI（k, j） = mtxAI（nIs（k）, j）
mtxAI（nIs（k）, j） = t
Next j
End If
If （nJs（k） <> k） Then
For i = 1 To n
t = mtxAR（i, k）
mtxAR（i, k） = mtxAR（i, nJs（k））
mtxAR（i, nJs（k）） = t
t = mtxAI（i, k）
mtxAI（i, k） = mtxAI（i, nJs（k））
mtxAI（i, nJs（k）） = t
Next i
End If
mtxAR（k, k） = mtxAR（k, k） / d
mtxAI（k, k） = -mtxAI（k, k） / d
For j = 1 To n
If （j <> k） Then
p = mtxAR（k, j） * mtxAR（k, k）
q = mtxAI（k, j） * mtxAI（k, k）
s = （mtxAR（k, j） + mtxAI（k, j）） * （mtxAR（k, k） + mtxAI（k, k））
mtxAR（k, j） = p - q
mtxAI（k, j） = s - p - q
End If
Next j
For i = 1 To n
If （i <> k） Then
For j = 1 To n
If （j <> k） Then
p = mtxAR（k, j） * mtxAR（i, k）
q = mtxAI（k, j） * mtxAI（i, k）
s = （mtxAR（k, j） + mtxAI（k, j）） * （mtxAR（i, k） + mtxAI（i, k））
t = p - q
b = s - p - q
mtxAR（i, j） = mtxAR（i, j） - t
mtxAI（i, j） = mtxAI（i, j） - b
End If
Next j
End If
Next i
For i = 1 To n
If （i <> k） Then
p = mtxAR（i, k） * mtxAR（k, k）
q = mtxAI（i, k） * mtxAI（k, k）
s = （mtxAR（i, k） + mtxAI（i, k）） * （mtxAR（k, k） + mtxAI（k, k））
mtxAR（i, k） = q - p
mtxAI（i, k） = p + q - s
End If
Next i
Next k
' 调整恢复行列次序
For k = n To 1 Step -1
If （nJs（k） <> k） Then
For j = 1 To n
t = mtxAR（k, j）
mtxAR（k, j） = mtxAR（nJs（k）, j）
mtxAR（nJs（k）, j） = t
t = mtxAI（k, j）
mtxAI（k, j） = mtxAI（nJs（k）, j）
mtxAI（nJs（k）, j） = t
Next j
End If
If （nIs（k） <> k） Then
For i = 1 To n
t = mtxAR（i, k）
mtxAR（i, k） = mtxAR（i, nIs（k））
mtxAR（i, nIs（k）） = t
t = mtxAI（i, k）
mtxAI（i, k） = mtxAI（i, nIs（k））
mtxAI（i, nIs（k）） = t
Next i
End If
Next k
' 求解成功
MCinv = True
End Function
VBA来解决大数据量计算逆矩阵的问题
EXCEL2003中应用minverse求逆矩阵，该函数在excel中的确存在计算范围上的限制，可能最大的计算范围是52*52。
下面给出一个VBA的解法
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"（DestinationAsAny,SourceAsAny,ByValLengthAsLong）
SubSwap（ByRefsA,ByRefsB）
Dimr AsLong
CopyMemoryr,ByValVarPtr（sA）,4
CopyMemoryByValVarPtr（sA）,ByValVarPtr（sB）,4
CopyMemoryByValVarPtr（sB）,r,4
EndSub
Sub求逆矩阵（ByValrAsRange）
DimA（）AsLong,B（）AsLong,iAsLong,jAsLong,kAsLong,NAsLong,DAsDouble,ttAsDouble,matrix
Application.ScreenUpdating=False
matrix=r.Value
Ifr.Rows.Count<>r.Columns.CountThenMsgBox"矩阵行数与列数不等":
ExitSub
N=r.Rows.Count
tt=Timer
ReDimA（N）,B（N）
Fork=1ToN
D=0#
Fori=kToN
Forj=kToN
If（Abs（matrix（i,j））>D）Then
D=Abs（matrix（i,j））
A（k）=i
B（k）=j
EndIf
Nextj,i
If（D+1#=1#）ThenMsgBox"矩阵行列式的值等于0":
ExitSub
If（A（k）<>k）Then
Forj=1ToN
Swapmatrix（k,j）,matrix（A（k）,j）
Next
EndIf
If（B（k）<>k）Then
Fori=1ToN
Swapmatrix（i,k）,matrix（i,B（k））
Next
EndIf
matrix（k,k）=1#/matrix（k,k）
Forj=1ToN
If（j<>k）Thenmatrix（k,j）=matrix（k,j）*matrix（k,k）
Next
Fori=1ToN
If（i<>k）Then
Forj=1ToN
If（j<>k）Thenmatrix（i,j）=matrix（i,j）-matrix（i,k）*matrix（k,j）
Next
EndIf
Next
Fori=1ToN
If（i<>k）Thenmatrix（i,k）=-matrix（i,k）*matrix（k,k）
Next
Next
Fork=NTo1Step-1
If（B（k）<>k）Then
Forj=1ToN
Swapmatrix（k,j）,matrix（B（k）,j）
Next
EndIf
If（A（k）<>k）Then
Fori=1ToN
Swapmatrix（i,k）,matrix（i,A（k））
Next
EndIf
Next
r.Offset（N+3,0）.Resize（N,N）.NumberFormatLocal="0.00000000"
r.Offset（N+3,0）.Resize（N,N）=matrix
Application.ScreenUpdating=True
MsgBox"OK!
程序运行"&Format（Timer-tt,"0.0000000"）&"秒"
EndSub
Subtest（）
求逆矩阵Sheets（"sheet1"）.[a1].CurrentRegion
EndSub
以上代码计算一个256*256的矩阵的逆矩阵，用时12秒左右，还是有点慢。
矩阵相乘
VB源码彩色显示注：
在[code]...[/code]内就以下面格式显示文字，双击源码拷贝到剪切板
PrivateFunctionRect_multip（A（）AsDouble,B（）AsDouble,nAsLong,n1AsLong,n2AsLong,C（）AsDouble）AsDouble'矩阵相乘n1*n的矩阵乘以n*n2的矩阵结果得矩阵C（n1,n2）DimT1AsLongDimT2AsLongDimT3AsLongForT1=0Ton1ForT2=0Ton2C（T1,T2）=0ForT3=0TonC（T1,T2）=C（T1,T2）+A（T1,T3）*B（T3,T2）NextT3NextT2NextT1EndFunction
升级会员 