[已解决]请教各位老师 ：费用平摊计算公式

cndelme

如何把当月公司费用平摊到当月项目费用,如果是其他忽略不计
比如
2014年1月  没有公司费用,那么所有项目费用(2个)保持一致
2014年8月份,公司费用10平均分摊到2种项目费用(袜子,电脑),袜子有2条记录在原来费用上增加 10/2/2=2.5,
2015年1月  项目费用数量1个(商品其它不分摊费用),鼠标有3条记录, 公司费用102/3 分别加到每条记录上
统计当月类别是项目费用+(当月公司费用/项目数量/相同项目记录的行数)

F列是统计的结果

谢谢大家了

最佳答案

月排行榜 / 总排行榜

xdragon

2015-5-10 15:33

=IF((C2="其他")+(D2="公司费用"),"",E2+SUMPRODUCT((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(D$2:D$13="公司费用")*E$2:E$13)/SUMPRODUCT((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(C$2:C$13=C2))/COUNT(0/((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(C$2:C$13<>"其他")*(D$2:D$13<>"公司费用")*FREQUENCY(ROW($1:$12),MATCH(TEXT(A$2:A$13,"emm")&C$2:C$13,TEXT(A$2:A$13,"emm")&C$2:C$13,))^0)))

要函数的话，写的有点长

跳转到最佳答案楼层

xdragon

1. Sub test()
   
2.     Dim rawdata, i As Long, d As Object, d1 As Object
   
3.     Dim re(), ym As String, ymPro As String
   
4.     Set d = CreateObject("scripting.dictionary"): Set d1 = CreateObject("scripting.dictionary")
   
5.     rawdata = Sheets("费用").Range("A1").CurrentRegion.Value
   
6.     ReDim re(1 To UBound(rawdata), 1 To 1)
   
7.     re(1, 1) = "平摊费用"
   
8.     For i = 2 To UBound(rawdata)
   
9.         ym = Format(rawdata(i, 1), "yyyymm")
   
10.         If rawdata(i, 4) <> "公司费用" And rawdata(i, 3) <> "其他" Then
    
11.             ymPro = ym & rawdata(i, 3)
    
12.             If Not d.exists(ymPro) Then d1(ym) = d1(ym) + 1
    
13.             d(ym & rawdata(i, 3)) = d(ym & rawdata(i, 3)) + 1
    
14.         Else
    
15.             d(ym) = rawdata(i, 5)
    
16.         End If
    
17.     Next
    
18.     For i = 2 To UBound(rawdata)
    
19.         ym = Format(rawdata(i, 1), "yyyymm")
    
20.         If rawdata(i, 4) <> "公司费用" And rawdata(i, 3) <> "其他" Then
    
21.             If d.exists(ym) Then
    
22.                 re(i, 1) = rawdata(i, 5) + d(ym) / d1(ym) / d(ym & rawdata(i, 3))
    
23.             Else
    
24.                 re(i, 1) = rawdata(i, 5)
    
25.             End If
    
26.         End If
    
27.     Next
    
28.     Range("F1").Resize(UBound(re)) = re
    
29. End Sub

复制代码

李建军

顶一下~~   绕好久都没绕粗来 ~ 期待函数版~{:2912:}

cndelme

xdragon 发表于 2015-5-10 13:59

谢谢学委  

好厉害的程序,先收下了

cndelme

李建军 发表于 2015-5-10 14:20
顶一下~~   绕好久都没绕粗来 ~ 期待函数版~

又见面了  

李建军

cndelme 发表于 2015-5-10 14:47
又见面了

哈哈 等礼拜一 老师们都上班了 就好好了 我也学习下~

xdragon

=IF((C2="其他")+(D2="公司费用"),"",E2+SUMPRODUCT((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(D$2:D$13="公司费用")*E$2:E$13)/SUMPRODUCT((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(C$2:C$13=C2))/COUNT(0/((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(C$2:C$13<>"其他")*(D$2:D$13<>"公司费用")*FREQUENCY(ROW($1:$12),MATCH(TEXT(A$2:A$13,"emm")&C$2:C$13,TEXT(A$2:A$13,"emm")&C$2:C$13,))^0)))

要函数的话，写的有点长

cndelme

xdragon 发表于 2015-5-10 15:33
=IF((C2="其他")+(D2="公司费用"),"",E2+SUMPRODUCT((TEXT(A2,"emm")=TEXT(A$2:A$13,"emm"))*(D$2:D$13="公 ...

好厉害的公式  谢谢 老师

还想请教一个问题，如果改成 ROW($1:1) 结果好像也一样，可以这样改吗

cndelme

cndelme 发表于 2015-5-10 18:51
好厉害的公式  谢谢 老师

还想请教一个问题，如果改成 ROW($1:1) 结果好像也一样，可以这样改吗

老师 再麻烦解答一下

第5，6对换 数值是不对了，为什么会有错呢

如果1000行的数据 ROW($1:1000)  ？对吗

xdragon

嗯，对的。不能少，少了会有错误。