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 i = 1 To n For l = 1 To n .Cells(i, n + l) = d(i, l) Next l Next i End With
MsgBox "計算終了。結果はシート2だす。" End Sub
Sub swap(ByRef a As Double, ByRef d As Double) Dim c c = a a = d d = c End Sub