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.

sheet

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

Popular posts from this blog

PHPMotion implementation - URL based videos (Hosted on separate location) -

javascript - Using Windows Media Player as video fallback for video tag -

c# - Unity IoC Lifetime per HttpRequest for UserStore -