zoukankan      html  css  js  c++  java
  • 用VBA来解决大数据量计算逆矩阵的问题

    EXCEL2003中应用minverse求逆矩阵,该函数在excel中的确存在计算范围上的限制,可能最大的计算范围是52*52。下面给出一个VBA的解法

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

    Sub Swap(ByRef sA, ByRef sB)
    Dim r     As Long
    CopyMemory r, ByVal VarPtr(sA), 4
    CopyMemory ByVal VarPtr(sA), ByVal VarPtr(sB), 4
    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 test()
    求逆矩阵 Sheets("sheet1").[a1].CurrentRegion
    End Sub

    以上代码计算一个256*256的矩阵的逆矩阵,用时12秒左右,还是有点慢。

  • 相关阅读:
    什么是动态链接库
    <<TCP/IP高效编程>>读书笔记
    C++ 函数
    我的vim配置
    FastReport4.6程序员手册_翻译
    DUnit研究初步
    ADO BUG之'无法为更新定位行....' 解决之道
    极限编程的集成测试工具Dunit
    总结
    项目管理检查清单项目启动
  • 原文地址:https://www.cnblogs.com/fengju/p/6336289.html
Copyright © 2011-2022 走看看