office excel解线性方程组(宏代码)

904次浏览 |434点赞 | 418评论 | 2020-07-29 00:37 更新

来源：互联网

最佳文档

本文由作者推荐

妊娠的读音-素数是什么意思

'打开excel,按alt+f8,编辑宏，把下面的代码全覆盖上去：
'使用方法：运行setextent来调整格式，输入题目后用solvelineequations来解，系数不输入视为0

Dim n As Integer
Sub setextent()
Dim x As Integer
'clear
If Range("A1").Borders(xlEdgeRight).Weight = xlThick Then
x = MsgBox("are you sure to clear?", vbOKCancel, "setextent")
If x = vbCancel Then Exit Sub
n = 1
Do Until Range(rangeselect(n, 0)).Borders(xlEdgeRight).Weight = xlThick
n = n + 1
Loop
Range("A1:" & rangeselect(n + 1, n)).ClearContents
Range("A1:" & rangeselect(n + 1, n)).yle = xlLineStyleNone
End If
'input
n = InputBox("setextent(1 to 700+)", "setextent")
If n > 1 Then
'getthicken
Range("A1:" & rangeselect(n + 1, n)).Borders(xlEdgeBottom).Weight = xlThick
Range("A1:" & rangeselect(n + 1, n)).Borders(xlEdgeRight).Weight = xlThick
Range("A1:" & rangeselect(n, n)).Borders(xlEdgeRight).Weight = xlThick
Range("A1:" & rangeselect(n + 1, 0)).Borders(xlEdgeBottom).Weight = xlThick
Range("A1:A" & n + 1).Borders(xlEdgeRight).Weight = xlThick
'write
Range("A1").Formula = "equnum"
Range(rangeselect(n + 1, 0)).Formula = "ans"
If n > 1 Then
For x = 2 To n
Range("A" & x & ":" & rangeselect(n + 1, x - 1)).Borders(xlEdgeBottom).Weight = xlThin
Next
End If
For x = 1 To n
Range(rangeselect(x, 0)).Formula = x
Next
For x = 1 To n
Range("A" & x + 1).Formula = x
Next
Range("B2").Select
Else
MsgBox "please reinput n", , "setextent"
n = 0
End If
End Sub
Sub solvelineequations()
'check
n = 0

If Range("A1").Borders(xlEdgeRight).Weight = xlThick Then
n = 1
Do Until Range(rangeselect(n, 0)).Borders(xlEdgeRight).Weight = xlThick
n = n + 1
Loop
End If
If n = 0 Or n = 1 Then
MsgBox "please set the extent", , "solve"
Exit Sub
End If
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim o As String
'input
ReDim a(n, n) As Double
ReDim b(n) As Double
For i = 1 To n
For j = 1 To n
Range(rangeselect(j, i)).Select
If Range(rangeselect(j, i)).Text = "" Then
a(i, j) = 0
Else
a(i, j) = Range(rangeselect(j, i)).Text
End If
Next
If Range(rangeselect(n + 1, i)).Text = "" Then
b(i) = 0
Else
b(i) = Range(rangeselect(n + 1, i)).Text
End If
Next
'calculating
o =
Sheets(o).Copy after:=Sheets(o)
= "Ans" & Format(Now, "yymmddhhnnss")
'step1
For i = 1 To n - 1
'change the seat
If a(i, i) = 0 Then
j = i + 1
Do Until a(j, i) <> 0
j = j + 1
If j > n Then
MsgBox "please check your input", , "solve"
o =

Exit Sub
End If
Loop
b(i) = b(i) + b(j)
b(j) = b(i) - b(j)
b(i) = b(i) - b(j)
For k = i To n
a(i, k) = a(i, k) + a(j, k)
a(j, k) = a(i, k) - a(j, k)
a(i, k) = a(i, k) - a(j, k)
Next
End If
'inmulti
b(i) = b(i) / a(i, i)
Range(rangeselect(n + 1, i)).Formula = b(i)
For j = n To i Step -1
a(i, j) = a(i, j) / a(i, i)
Range(rangeselect(j, i)).Formula = a(i, j)
Next
'minus
For j = i + 1 To n
For k = i + 1 To n
a(j, k) = a(j, k) - a(i, k) * a(j, i)
Range(rangeselect(k, j)).Formula = a(j, k)
Next
b(j) = b(j) - b(i) * a(j, i)
Range(rangeselect(n + 1, j)).Formula = b(j)
a(j, i) = 0
Range(rangeselect(i, j)).Formula = a(j, i)
Next
Next
If a(n, n) = 0 Then
MsgBox "please check your input", , "solve"
Exit Sub
End If
b(n) = b(n) / a(n, n)
Range(rangeselect(n + 1, n)).Formula = b(n)
a(n, n) = 1
Range(rangeselect(n, n)).Formula = a(n, n)
'step2
For i = n - 1 To 1 Step -1
For j = i + 1 To n
b(i) = b(i) - b(j) * a(i, j)
Range(rangeselect(n + 1, i)).Formula = b(i)
a(i, j) = 0
Range(rangeselect(j, i)).Formula = a(i, j)
Next
Next
'output
'For i = 1 To n
' For j = 1 To n
' Range(Chr(65 + j) & i + 1).Select
' aR1C1 = a(i, j)
' Next
' Range(Chr(66 + n) & i + 1).Select
' aR1C1 = b(i)
'Next
MsgBox "done", , "solve"
End Sub
Private Function rangeselect(x As Integer, y As Integer) As String
Dim z As Integer
Dim w As Integer
z = x + 1
w = y + 1
'step1
If z > 0 And z <= 26 Then
rangeselect = Chr(64 + z)
Else
If z > 26 And z <= 702 Then
rangeselect = Chr(64 + z 26) & Chr(65 + z Mod 26)
Else
rangeselect = Chr(64 + z 676) & Chr(65 + (z Mod 676) 26) & Chr(65 + z Mod 26)
End If
End If
'step2
rangeselect = rangeselect & w
End Function