| |
逆行列のソースなんですがうまく行かないんです。
至急間違えを教えて下さい。
Sub gyaku()
Dim n As Integer
Dim a() As Double, d() As Double
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim ip As Integer
Dim p As Double, r As Double
With Worksheets("Sheet1")
n = .Cells(2, 3)
End With
ReDim d(n, n) As Double
With Worksheets("Sheet2")
For i = 1 To n
For l = 1 To n
If i = l Then
d(i, l) = 1
.Cells(i, 2 * n + j) = d(i, l)
Else
d(i, l) = 0
.Cells(i, 2 * n + j) = d(i, l)
End If
Next l
Next i
End With
ReDim a(n, n) As Double
ReDim d(n, n) As Double
MsgBox "計算開始。行列サイズは" & n & "だす。"
With Worksheets("Sheet2")
For i = 1 To n
For j = 1 To n
a(i, j) = .Cells(i, j).Value
Next j
Next i
End With
With Worksheets("Sheet2")
For i = 1 To n
For l = 1 To n
d(i, l) = .Cells(i, 2 * n + l).Value
Next l
Next i
End With
For l = 1 To n
For k = 1 To n
p = 0
ip = 0
For i = k To n
If p < Abs(a(i, k)) Then
p = Abs(a(i, k))
ip = i
Exit For
End If
Next i
If ip = 0 Then
MsgBox "行列が得意である(PIVOT=0)", vbCritical
Exit For
End If
If ip > k Then
For j = k To n
swap a(k, j), a(ip, j)
Next j
swap d(k, l), d(ip, l)
End If
r = a(k, k)
For j = k To n
a(k, j) = a(k, j) / r
Next j
d(k, l) = d(k, l) / r
For i = 1 To n
If i <> k Then
r = a(i, k)
For j = k To n
a(i, j) = a(i, j) - r * a(k, j)
Next j
d(i, l) = d(i, l) - r * d(k, l)
End If
Next i
Next k
Next l
With Worksheets("Sheet2")
For l = 1 To n
For i = 1 To n
.Cells(i, n + l) = d(i, l)
Next i
Next l
End With
MsgBox "計算終了。結果はシート２だす。"
End Sub
Sub swap(ByRef a As Double, ByRef d As Double)
Dim c
c = a
a = d
d = c
End Sub
|
|
素人
- 05/12/20(火) 13:06 -
