Нахождение обратной матрицы

'к нажатию кнопки "Решить"
Sub Work()
'Считываем из таблицы
'коэффициенты при переменных
Dim a(1 To 7, 1 To 7)
For i = 1 To 7
For j = 1 To 7
a(i, j) = Re(i, j)
Next j
Next i
'Считываем из таблицы
'свободные коэффициенты
Dim b(1 To 7)
For i = 1 To 7
b(i) = Re(i, 8)
Next i
Dim x(1 To 7) 'Массив переменных
'Решаем СЛАУ методом Крамера
Call Cramer(a, b, x)
'Выводим найденное решение в таблицу
For i = 1 To 7
Call Wr(i + 2, 11, x(i))
Next i
End Sub
'Процедура вывода в ячейки таблицы
Sub Wr(i, j, val)
Worksheets("Лист1").Cells(i, j).Value = val
End Sub
'Функция чтения значений ячеек таблицы
Function Re(i, j)
Re = Worksheets("Лист1").Cells(i, j).Value
End Function
'Функция нахождения детерминанта
Function det(a, r)
If r = 1 Then
d = a(1, 1)
Else
Dim a2(1 To 7, 1 To 7)
d = 0
For k = 1 To r
i2 = 0
For i = 1 To r
If i <> k Then
i2 = i2 + 1
For j = 2 To r
a2(i2, j - 1) = a(i, j)
Next j
End If
Next i
r2 = r - 1
If (k Mod 2 = 1) Then
d = d + a(k, 1) * det(a2, r2)
Else
d = d - a(k, 1) * det(a2, r2)
End If
Next k
End If
det = d
End Function
 
'Процедура решения системы линейных
'алгебраических уравнений методом Крамера
Sub Cramer(a, b, x)
Dim a2(1 To 7, 1 To 7)
For i = 1 To 7
For j = 1 To 7
a2(i, j) = a(i, j)
Next j
Next i
delta = det(a2, 7)
If delta = 0 Then
For i = 1 To 7
x(i) = "No"
Next i
Else
For k = 1 To 7
For i = 1 To 7
For j = 1 To 7
a2(i, j) = a(i, j)
Next j
Next i
For i = 1 To 7
a2(i, k) = b(i)
Next i
deltaN = det(a2, 7)
x(k) = deltaN / delta
Next k
End If
End Sub

Sub Kramer(A() As Double, Y() As Double, R() As Double, flgRes As Boolean)
Dim T() As Double
    n% = UBound(Y, 1)
    D_main = Det(A)
    If Abs(D_main) <= 0.0000000001 Then
       flgRes = False
       Exit Sub
    End If
    ReDim T(1 To n%, 1 To n%) As Double
    For ii% = 1 To n%
        For i% = 1 To n%
            For j% = 1 To n%
                T(i%, j%) = A(i%, j%)
            Next j%
        Next i%
        For j% = 1 To n%
            T(j%, ii%) = Y(j%)
        Next j%
        R(ii%) = Det(T) / D_main
    Next ii%
    flgRes = True
End Sub
 
Function Det(A() As Double) As Double
     n% = UBound(A, 1)
     If n% = 1 Then
        Det = A(1, 1)
     ElseIf n% = 2 Then
        Det = A(1, 1) * A(2, 2) - A(1, 2) * A(2, 1)
     Else
        s# = 1
        For j% = 1 To n%
            Det = Det + A(1, j%) * Det(Minor(A(), 1, j%)) * s#
            s# = -s#
        Next j%
     End If
End Function
 
Function Minor(A() As Double, M As Integer, k As Integer) As Double()
Dim B() As Double
    nn% = UBound(A, 1)
    ReDim B(1 To nn% - 1, 1 To nn% - 1) As Double
    ii% = 1
    jj% = 1
    For i% = 1 To nn%
        For j% = 1 To nn%
            If i% <> M And j% <> k Then
               B(ii%, jj%) = A(i%, j%)
               jj% = jj% + 1
               If jj% > nn% - 1 Then
                  ii% = ii% + 1
                  jj% = 1
               End If
            End If
        Next j%
     Next i%
     Minor = B
End Function
 
Sub Test()
 
Dim A(1 To 4, 1 To 4) As Double
Dim Y(1 To 4)         As Double
Dim R(1 To 4)         As Double
Dim flg               As Boolean
 
    A(1, 1) = 1
    A(1, 2) = 1
    A(1, 3) = 1
    A(1, 4) = 1
    
    A(2, 1) = 2
    A(2, 2) = 1
    A(2, 3) = 2
    A(2, 4) = 1
    
    A(3, 1) = 0
    A(3, 2) = 1
    A(3, 3) = 3
    A(3, 4) = -2
    
    A(4, 1) = 7
    A(4, 2) = 1
    A(4, 3) = -1
    A(4, 4) = 5
    
    Y(1) = 0
    Y(2) = 2
    Y(3) = 4
    Y(4) = 0
 
    Kramer A, Y, R, flg
    
    If flg Then
    
       For i% = 1 To 4
           Debug.Print R(i%)
       Next i%
       
    Else
    
       Debug.Print "Ðåøåíèé íåò!"
       
    End If
    
End Sub

For j% = 1 To n%
T(j%, ii%) = Y(j%)
Next ii%
R(ii%) = Det(T) / D_main
Cells(ii * (n% + 1) + 3, j%) = T(i%, j%)
Cells(ii + 3, 12) = Det(T)
Cells(ii + 3, 12) = R(ii%)