| |
▼素人 さん：
a()とd()は
平行して同じ処理をする必要があります。
ループもなぜか１つ多い気がしますね。
私にはこれが限界かな。
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)
.Cells(i, 2 * n + l) = d(i, l)
Else
d(i, l) = 0
' .Cells(i, 2 * n + j) = d(i, l)
.Cells(i, 2 * n + l) = 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)
swap d(k, j), d(ip, j)
Next j
' swap d(k, l), d(ip, l)
End If
r = a(k, k)
' For j = k To n
For j = 1 To n
a(k, j) = a(k, j) / r
d(k, j) = d(k, j) / r '*
Next j
' d(k, l) = d(k, l) / r
' For i = k To n
For i = 1 To n
If i <> k Then
r = a(i, k)
' For j = k To n
For j = 1 To n
a(i, j) = a(i, j) - r * a(k, j)
d(i, j) = d(i, j) - r * d(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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
