vba计算逆矩阵

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Sub Swap(ByRef sA, ByRef sB) 'byref按引用传递优点：节约一个内存地址的大小，并且实现数值的修改。

'byval 是为这个变量在内存中重新开辟一个地址进行存储。
Dim r As LongPtr
CopyMemory r, ByVal VarPtr(sA), 4
'在VBA中，CopyMemory是一个用于内存操作的函数。它可以用来将一个内存块的内容复制到另一个内存块中。
'使用CopyMemory函数可以实现在VBA中进行底层的内存操作，比如复制数组、结构体等数据类型。
'需要注意的是，使用CopyMemory函数需要在VBA代码中声明CopyMemory函数的原型，如上述代码所示。
CopyMemory ByVal VarPtr(sA), ByVal VarPtr(sB), 4
'VBA中的VarPtr函数用于获取变量的内存地址。
'它接受一个变量作为参数，并返回该变量在内存中的地址。
'VarPtr函数只能用于基本数据类型的变量，例如整数、长整数、单精度浮点数、双精度浮点数等。
'对于对象类型的变量，需要使用ObjPtr函数来获取对象的内存地址
CopyMemory ByVal VarPtr(sB), r, 4
End Sub

Sub 求逆矩阵(ByVal r As Range)
Dim a() As Long, b() As Long, i As Long, j As Long, k As Long, N As Long, D As Double, tt As Double, matrix
Application.ScreenUpdating = False
matrix = r.Value
If r.Rows.Count <> r.Columns.Count Then MsgBox "矩阵行数与列数不等": Exit Sub
N = r.Rows.Count
tt = Timer
ReDim a(N), b(N)
For k = 1 To N
    D = 0#
    For i = k To N
        For j = k To N
            If (Abs(matrix(i, j)) > D) Then
                D = Abs(matrix(i, j))
                a(k) = i
                b(k) = j
            End If
        Next j, i
    If (D + 1# = 1#) Then MsgBox "矩阵行列式的值等于0":   Exit Sub
    If (a(k) <> k) Then
        For j = 1 To N
        Swap matrix(k, j), matrix(a(k), j)
        Next
    End If
    If (b(k) <> k) Then
        For i = 1 To N
           Swap matrix(i, k), matrix(i, b(k))
         Next
    End If
    matrix(k, k) = 1# / matrix(k, k)
    For j = 1 To N
        If (j <> k) Then matrix(k, j) = matrix(k, j) * matrix(k, k)
    Next
    For i = 1 To N
        If (i <> k) Then
            For j = 1 To N
                If (j <> k) Then matrix(i, j) = matrix(i, j) - matrix(i, k) * matrix(k, j)
            Next
        End If
    Next
    For i = 1 To N
        If (i <> k) Then matrix(i, k) = -matrix(i, k) * matrix(k, k)
    Next
Next

For k = N To 1 Step -1
    If (b(k) <> k) Then
      For j = 1 To N
        Swap matrix(k, j), matrix(b(k), j)
      Next
    End If
    If (a(k) <> k) Then
      For i = 1 To N
        Swap matrix(i, k), matrix(i, a(k))
      Next
    End If
Next
r.Offset(N + 3, 0).Resize(N, N).NumberFormatLocal = "0.00000000"
r.Offset(N + 3, 0).Resize(N, N) = matrix
Application.ScreenUpdating = True
MsgBox "OK!  程序运行" & Format(Timer - tt, "0.0000000") & "秒"
End Sub


Sub mytest()
'vba7环境下
求逆矩阵 Application.ActiveSheet.Cells(1, 1).CurrentRegion
End Sub