线性系统求解（N * Nmatrix乘法），VBA
我有2个数组。 Array1是n * n ， Array2是1 * n 。
这些数组在工作表中给出。 在这种情况下Sheet3和Sheet4，我需要在Sheet5上输出答案。
我得到多个错误，如“下标超出范围”。
我似乎无法弄清楚为什么这不起作用：
Public Sub LinearSystemSolver() x = Sheet3.UsedRange.Rows.Count y = Sheet3.UsedRange.Columns.Count Z = Sheet4.UsedRange.Rows.Count Dim a As Variant ReDim a(1 To x, 1 To y) Dim b As Variant ReDim b(1 To Z, 1 To 1) Dim g As Variant ReDim g(1 To Z, 1 To 1) For i = 1 To x For j = 1 To y a(i, j) = Sheet3.Cells(i, j) Next Next For f = 1 To Z b(f,1) = Sheet4.Cells(f,1) Next g = Application.WorksheetFunction.MMult((Application.WorksheetFunction.MInverse(a)), b) For h = 1 To Z Sheet5.Cells(h, 1) = g(h, 1) Next End Sub
您可以通过直接分配数组来加速代码，避免循环
a = Sheet3.Range("A1").Resize(x,y).Value b = Sheet4.Range("A1").Resize(z,1).Value ... Sheet5.Range("A1").Resize(z,1).Value = g
现在，只要反转matrix（如果x=y=z ），我build议使用LU分解。 我附上了一个我已经使用多年的工作例子。
驱动程序代码是
Private Sub solveButton_Click() Dim lu As New LuSolver ' Get Matrix values and decompose them into L, U, P form ' Values are in B3 and matrix is a 5×5 size lu.IntializeFromRange Range("B3"), 5 ' Solve the A*x=b matrix system for x ' right hand side is in J3 and it is a 5×1 size ' resulting 5×1 matrix will be placed under H3 lu.Solve Range("J3"), 1, Range("H3") End Sub
与LUparsing器在一个叫“LuSolver”的类中
'--------------------------------------------------------------------------------------- ' Module : LuSolver ' DateTime : 6/30/2008 13:01 ' Author : ja72 ' Purpose : LU Decomposition of rectangular matrix. ' Remarks: 'For an n-by-n matrix A, the LU decomposition is an n-by-n 'unit lower triangular matrix L, an n-by-n upper triangular matrix U, 'and a permutation vector piv of length n so that A(piv)=L*U. '--------------------------------------------------------------------------------------- Option Explicit Private lu As Variant Private sign As Integer Private pivot() As Integer Private size As Integer Private Sub Class_Initialize() Set lu = Nothing Erase pivot sign = 1 End Sub Private Sub Class_Terminate() Set lu = Nothing Erase pivot sign = 0 End Sub Public Sub IntializeFromRange(ByRef r_coef As Range, ByVal matrix_size As Integer) Dim k_max As Integer, k As Integer, p As Integer Dim i As Integer, j As Integer Dim s As Variant On Error GoTo IntializeFromRange_Error lu = r_coef.Resize(matrix_size, matrix_size).Value size = matrix_size 'Set pivot as a sequence of integers ReDim pivot(1 To size) For i = 1 To size pivot(i) = i Next i sign = 1 For j = 1 To size 'Apply previous transformations For i = 1 To size If j > i Then k_max = i Else k_max = j s = 0 'Time consuming dot product For k = 1 To k_max - 1 s = s + lu(i, k) * lu(k, j) Next k lu(i, j) = lu(i, j) - s Next i 'Find the pivot element p = j For i = j + 1 To size If Abs(lu(i, j)) > Abs(lu(p, j)) Then p = i End If Next i 'Exchange pivot rows If p <> j Then For k = 1 To size s = lu(p, k) lu(p, k) = lu(j, k) lu(j, k) = s Next k k = pivot(p) pivot(p) = pivot(j) pivot(j) = k sign = -sign End If 'Compute Multipliers s = lu(j, j) If j <= size And s <> 0 And s <> 1 Then For i = j + 1 To size lu(i, j) = lu(i, j) / s Next i End If Next j On Error GoTo 0 Exit Sub IntializeFromRange_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IntializeFromRange of Class Module LuDecomposition" End Sub Public Property Get IsSingular() As Boolean IsSingular = Not IsNonSingular End Property Public Property Get IsNonSingular() As Boolean IsNonSingular = True Dim j As Integer For j = 1 To size If lu(j, j) = 0 Then IsNonSingular = False Exit Property End If Next j End Property Public Sub Solve(ByRef r_rhs As Range, ByVal no_of_columns, ByRef r_result As Range) On Error GoTo Solve_Error Dim rhs As Variant Dim N As Integer, M As Integer, r As Integer Dim i As Integer, j As Integer, k As Integer N = size M = size r = no_of_columns rhs = r_rhs.Resize(size, r).Value 'Copy rhs with pivoting Dim X As Variant ReDim X(1 To size, 1 To r) For i = 1 To size For j = 1 To r X(i, j) = rhs(pivot(i), j) Next j Next i 'Solve L*Y = B For k = 1 To M For i = k + 1 To M For j = 1 To r X(i, j) = X(i, j) - X(k, j) * lu(i, k) Next j Next i Next k 'Solve U*X=Y For k = M To 1 Step -1 For j = 1 To r X(k, j) = X(k, j) / lu(k, k) Next j For i = 1 To k - 1 For j = 1 To r X(i, j) = X(i, j) - X(k, j) * lu(i, k) Next j Next i Next k r_result.Resize(size, no_of_columns).Value = X On Error GoTo 0 Exit Sub Solve_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Solve of Class Module LuDecomposition" End Sub
在下面，循环Cells（）需要两个参数：
For f = 1 To Z b(f) = Sheet4.Cells(f) Next
可能还有其他问题。