i have group of people have different expenses during period. has balance after period. looks in excel:
person a: 6
person b: 10
person c: -7,5
person d: -8,5
after period settlement take place. manually. results in:
person c pays 6 person a.
person c pays 1,5 person b.
person d pays 8,5 person b.
person gets 6 person c.
person b gets 1,5 form person c.
peron b gets 8,5 person d.
(there multiple solutions possible when more persons involved.)
the problem have apply procedure big group of people. question is: 'how apply 'who owes who'-procedure using excel spreadsheet algorithm or macro?'.
i made excel version in open office. can download that? following macro might work on own. if not should small. works fine in ooo , saved excel 97/2000 workbook document.
'this might not needed in microsoft excel, comment out option vbasupport 1 'owes option explicit 'cells(row, col), private sub cmd1_click() 'data same sheet, row 4, column 4 'row 4 has names in columns, 4,4 has name 1, 4,5 has name 2 'row 5 has amounts spent 6, -10 'output in columns 3 , 5 dim dim j,s string, sum1 s="" 'get number of cells used in row 4 , check if corresponding row 6 column has number value = 4 sum1=0 while(cells(4,i).value <> "" , < 500) j = cdbl(cells(5,i).value) sum1 = sum1 + j if j <> cells(5,i).value msgbox "col " & & " not number?" end end if i=i+1 loop if > 499 msgbox "too many cols" end end if if sum1 > 0.3 or sum1 < -0.3 msgbox "sum not near 0 :" & sum1 end end if dim colcnt integer colcnt = - 4 cells (7,1).value = "col count = " & colcnt dim spent(colcnt) double dim owes1(colcnt ) string dim owes2(colcnt ) string i= 4 colcnt + 3 spent(i - 3) = cdbl(cells(5,i).value) next dim cnt,lastneg, abs1,maxpay ' safety var never ending loops, if data bad many cols , more .1 diffs lastneg = 4 dim lastpay1 lastpay1 = 10 dim ii,jj,c1,c2,topay topay = 0 on local error goto errh i= 4 colcnt + 3 cnt = 0 ii = - 3 c1 = spent(ii) 'cells(6,i) = "ok " if spent(ii) > 0.1 , cnt < colcnt '//has take cnt = cnt + 1 j = lastneg colcnt + 3 ' ; j < people.length && spent(ii) > 0.1; j++) jj = j - 3 's = s & me.cells(ii,j) & " " if spent(ii) > 0.1 if spent(jj) < -0.1 ' //has give , has balance give c1 = spent(ii) c2 = spent(jj) lastneg = j abs1 = spent(jj) * -1'//can use absolute fn maxpay = abs1 if(maxpay > spent(ii)) topay = spent(ii)' else topay = abs1 end if spent(ii) = spent(ii) - topay spent(jj) = spent(jj) + topay cells(lastpay1, 3).value = cells(4 , j) & " pays " & topay & " " & cells(4 , ) cells(lastpay1, 5).value = cells(4 , i) & " gets " & topay & " " & cells(4 , j) lastpay1 = lastpay1 + 1 end if end if next end if next msgbox "done" err.clear if err.number <> 0 errh: dim yy yy = msgbox("err " & err.number & " " & err.description & " continue", 2) if yy = vbyes resume next end if end if end sub book @ http://sel2in.com/prjs/vba/profile (owes)
can see http://www.excel-vba.com/ , http://office.microsoft.com/en-in/training/get-in-the-loop-with-excel-macros-rz001150634.aspx in excel useful (f1 inside macro editor, can select keyword or type , context sensitive pressing f1)
Comments
Post a Comment