VBA化矩阵为阶梯形矩阵[消元法解线性方程组]

hubulwm

线性代数中的的消元法解一般线性方程组的小代码，大用处，代码奉上，供您学习线性代数求解行列式、解线性方程组等使用：

1. Option Explicit
   
2. '初等变换化矩阵为阶梯形矩阵(Echelon matrix)
   
3. Sub Echelon_matrix()
   
4.     Dim UserRange As Range
   
5.     Dim RowMax As Long
   
6.     Dim ColMax As Long
   
7.     Dim i As Long, j As Long, t As Long, s As Long
   
8.     Dim temp
   
9.     Dim fg As Boolean
   
10.     Dim Arr()
    
11.     '提示选择区域
    
12.     On Error GoTo Canceled
    
13.     Set UserRange = Application.InputBox(Prompt:="请选择矩阵区域:", Title:="获取矩阵", Default:=Selection.Address, Type:=8)
    
14.     RowMax = UserRange.Rows.Count
    
15.     ColMax = UserRange.Columns.Count
    
16.     ReDim Arr(1 To RowMax, 1 To ColMax)
    
17.     For i = 1 To RowMax
    
18.         For j = 1 To ColMax
    
19.             If IsNumeric(UserRange.Cells(i, j)) = True Or UserRange.Cells(i, j) = "" Then
    
20.                 Arr(i, j) = UserRange.Cells(i, j)
    
21.                 Else
    
22.                 UserRange.Cells(i, j).Activate
    
23.                 MsgBox "这个单元格内不是数字！"
    
24.                 Exit Sub
    
25.             End If
    
26.         Next j
    
27.     Next i
    
28.     '化获取的矩阵为阶梯形矩阵
    
29.     For i = 1 To RowMax - 1
    
30.         '第一步：对角搜寻
    
31.         If i <= ColMax Then
    
32.         If Arr(i, i) = 0 Then
    
33.         '第3种初等变换——互换矩阵中两行的位置
    
34.             fg = False
    
35.             For t = i + 1 To RowMax
    
36.                 If Arr(t, i) <> 0 Then
    
37.                     If i <= ColMax Then
    
38.                     For s = i To ColMax
    
39.                         temp = Arr(i, s)
    
40.                         Arr(i, s) = Arr(t, s)
    
41.                         Arr(t, s) = temp
    
42.                     Next s
    
43.                     fg = True
    
44.                     End If
    
45.                 End If
    
46.                 If fg = True Then Exit For
    
47.             Next t
    
48.         End If
    
49.         '如果
    
50.         If Arr(i, i) <> 0 Then
    
51.         '第2种初等变换——把矩阵中的第i行的-arr(t,i)/arr(i,i)倍加到以后的每一行
    
52.         For t = i + 1 To RowMax
    
53.             If i < ColMax Then
    
54.             temp = Arr(t, i) / Arr(i, i)
    
55.                 For s = i To ColMax
    
56.                     Arr(t, s) = Arr(t, s) - temp * Arr(i, s)
    
57.                 Next s
    
58.             End If
    
59.         Next t
    
60.         Else
    
61.         '第二步：如果已搜寻的一列都为0，则向右缩小范围搜寻
    
62.          '第2种初等变换——把矩阵中的第i行的-arr(t,i+1)/arr(i,i+1)倍加到以后的每一行
    
63.             If i < ColMax Then
    
64.             If Arr(i, i + 1) <> 0 Then
    
65.                 For t = i + 1 To RowMax
    
66.                     If i < ColMax Then
    
67.                       temp = Arr(t, i + 1) / Arr(i, i + 1)
    
68.                       For s = i + 1 To ColMax
    
69.                         Arr(t, s) = Arr(t, s) - temp * Arr(i, s)
    
70.                       Next s
    
71.                       End If
    
72.                 Next t
    
73.             End If
    
74.             End If
    
75.         End If
    
76.         End If
    
77.     Next i
    
78.     '提示选择方程组结果输出区域
    
79.     Set UserRange = Application.InputBox(Prompt:="请选择输出区域:", Title:="输出区域", Default:=Selection.Address, Type:=8)
    
80.     UserRange.Range("A1").Resize(RowMax, ColMax) = Arr
    
81.     '设置小数显示为分数
    
82.     For i = 1 To RowMax
    
83.         For j = 1 To ColMax
    
84.             If Int(Arr(i, j)) <> Arr(i, j) Then UserRange.Range("A1").Offset(i - 1, j - 1).NumberFormatLocal = "????/????"
    
85.         Next j
    
86.     Next i
    
87. Canceled:
    
88. End Sub
    

复制代码

jsxjd

用矩阵求逆不行吗？

hubulwm

jsxjd 发表于 2014-7-6 22:05
用矩阵求逆不行吗？

当然可以实现求逆矩阵，上面的代码仅仅实现化成阶梯形，求逆矩阵的代码等待后继贴出来。

jsxjd

hubulwm 发表于 2014-7-6 22:40
当然可以实现求逆矩阵，上面的代码仅仅实现化成阶梯形，求逆矩阵的代码等待后继贴出来。

有现成的函数

liuxingcsu

居然发现线代都忘得差不多了

hubulwm

jsxjd 发表于 2014-7-7 07:52
有现成的函数

矩阵求逆公式要求是方阵，上面的代码矩阵行列阶数都不限。

jsxjd

hubulwm 发表于 2014-7-8 18:21
矩阵求逆公式要求是方阵，上面的代码矩阵行列阶数都不限。

非方的应该是线性规划吧？

hubulwm

jsxjd 发表于 2014-7-8 23:04
非方的应该是线性规划吧？

非方的矩阵多了，同时上面代码可实现求解任意矩阵的秩。

jsxjd

hubulwm 发表于 2014-7-15 12:31
非方的矩阵多了，同时上面代码可实现求解任意矩阵的秩。

存在精度问题

hubulwm

jsxjd 发表于 2014-7-15 13:30
存在精度问题

是的，本代码所能解决的只限于有理数范围的矩阵，对于无理数及实数、文字等其他非有理数矩阵就失效了。但分数的矩阵可以解决。所以上面代码只是学生版，供探讨使用。