excel - Linear system solving ( N*N matrix multiplication ), VBA -
i have 2 arrays. array1
n * n
, array2
1 * n
.
these arrays given in worksheets. in case sheet3 , sheet4 , need output answer on sheet5.
i multiple errors "subscript out of range".
i can't seem figure out why isn't working:
public sub linearsystemsolver() x = sheet3.usedrange.rows.count y = sheet3.usedrange.columns.count z = sheet4.usedrange.rows.count dim variant redim a(1 x, 1 y) dim b variant redim b(1 z, 1 1) dim g variant redim g(1 z, 1 1) = 1 x j = 1 y a(i, j) = sheet3.cells(i, j) next next f = 1 z b(f,1) = sheet4.cells(f,1) next g = application.worksheetfunction.mmult((application.worksheetfunction.minverse(a)), b) h = 1 z sheet5.cells(h, 1) = g(h, 1) next end sub
you can speed code assigning arrays directly , avoid loops
a = sheet3.range("a1").resize(x,y).value b = sheet4.range("a1").resize(z,1).value ... sheet5.range("a1").resize(z,1).value = g
now far inverting matrix (if x=y=z
) propose use lu
decomposition. have attached working example have used many years.
the driver code is
private sub solvebutton_click() dim lu new lusolver ' matrix values , decompose them l, u, p form ' values in b3 , matrix 5×5 size lu.intializefromrange range("b3"), 5 ' solve a*x=b matrix system x ' right hand side in j3 , 5×1 size ' resulting 5×1 matrix placed under h3 lu.solve range("j3"), 1, range("h3") end sub
with lu solver in class called 'lusolver"
'--------------------------------------------------------------------------------------- ' module : lusolver ' datetime : 6/30/2008 13:01 ' author : ja72 ' purpose : lu decomposition of rectangular matrix. ' remarks: 'for n-by-n matrix a, lu decomposition n-by-n 'unit lower triangular matrix l, n-by-n upper triangular matrix u, 'and permutation vector piv of length n a(piv)=l*u. '--------------------------------------------------------------------------------------- option explicit private lu variant private sign integer private pivot() integer private size 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 range, byval matrix_size integer) dim k_max integer, k integer, p integer dim integer, j integer dim s variant on error goto intializefromrange_error lu = r_coef.resize(matrix_size, matrix_size).value size = matrix_size 'set pivot sequence of integers redim pivot(1 size) = 1 size pivot(i) = next sign = 1 j = 1 size 'apply previous transformations = 1 size if j > k_max = else k_max = j s = 0 'time consuming dot product k = 1 k_max - 1 s = s + lu(i, k) * lu(k, j) next k lu(i, j) = lu(i, j) - s next 'find pivot element p = j = j + 1 size if abs(lu(i, j)) > abs(lu(p, j)) p = end if next 'exchange pivot rows if p <> j k = 1 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 , s <> 0 , s <> 1 = j + 1 size lu(i, j) = lu(i, j) / s next 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 issingular() boolean issingular = not isnonsingular end property public property isnonsingular() boolean isnonsingular = true dim j integer j = 1 size if lu(j, j) = 0 isnonsingular = false exit property end if next j end property public sub solve(byref r_rhs range, byval no_of_columns, byref r_result range) on error goto solve_error dim rhs variant dim n integer, m integer, r integer dim integer, j integer, k integer n = size m = size r = no_of_columns rhs = r_rhs.resize(size, r).value 'copy rhs pivoting dim x variant redim x(1 size, 1 r) = 1 size j = 1 r x(i, j) = rhs(pivot(i), j) next j next 'solve l*y = b k = 1 m = k + 1 m j = 1 r x(i, j) = x(i, j) - x(k, j) * lu(i, k) next j next next k 'solve u*x=y k = m 1 step -1 j = 1 r x(k, j) = x(k, j) / lu(k, k) next j = 1 k - 1 j = 1 r x(i, j) = x(i, j) - x(k, j) * lu(i, k) next j next 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
Comments
Post a Comment