[已解决]双条件加总金额

yf_home

  如题，双条件加总金额，谢谢。

     附件：    456.zip (492.06 KB, 下载次数: 6)

2017-5-31 20:26 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2017-6-2 10:12

按列汇总，先用公式，再转成数值。

1. Sub zz()
   
2.     Dim d, arr, brr
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("明細").Range("A1:AT" & Sheets("明細").[b654321].End(3).Row)
   
5.     For i = 4 To UBound(arr)
   
6.         For j = 35 To 46
   
7.             x = arr(i, 2) & arr(3, j)
   
8.             d(x) = d(x) + arr(i, j)
   
9.         Next
   
10.     Next
    
11.     With Sheets("金額分析")
    
12.         .[C3:N32] = ""
    
13.         rmax = .[b65536].End(3).Row
    
14.         brr = .Range("B2:O" & rmax)
    
15.         For i = 2 To UBound(brr)
    
16.             For j = 2 To 13
    
17.                 x = brr(i, 1) & brr(1, j)
    
18.                 brr(i, j) = d(x)
    
19.                 S = S + d(x)
    
20.             Next
    
21.             If S > 0 Then brr(i, j) = S: S = 0
    
22.         Next
    
23.         .Range("B2:O" & .[b65536].End(3).Row) = brr
    
24.         .Cells(rmax + 1, 2) = "合计"
    
25.         .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1).Formula = "=sum(r2c:r[-1]c)"   '按月用公式计算
    
26.         .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1) = .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1).Value  '公式换成数值
    
27.     End With
    
28. End Sub
    

复制代码

跳转到最佳答案楼层

小小菜鸟学EXCEL

=SUMIF(明細!$B:$B,$B3,OFFSET(明細!$AH$1,,COLUMN(A1)))
一个SUMIF右拉下拉就完事儿了。也不会卡。干嘛一定要VBA呢？

yf_home

小小菜鸟学EXCEL 发表于 2017-5-31 20:57
=SUMIF(明細!$B:$B,$B3,OFFSET(明細!$AH$1,,COLUMN(A1)))
一个SUMIF右拉下拉就完事儿了。也不会卡。干嘛一 ...

明细表数据有12万多行，只是论坛上传不了那么多，我删除了。
数据量太大，用公式真的很卡的。

opelwang

非常感謝，很好！

grf1973

1. Sub zz()
   
2.     Dim d, arr, brr
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("明細").Range("A1:AT" & Sheets("明細").[b654321].End(3).Row)
   
5.     For i = 4 To UBound(arr)
   
6.         For j = 35 To 46
   
7.             x = arr(i, 2) & arr(3, j)
   
8.             d(x) = d(x) + arr(i, j)
   
9.         Next
   
10.     Next
    
11.     With Sheets("金額分析")
    
12.         .[C3:N32] = ""
    
13.         brr = .Range("B2:O" & .[b65536].End(3).Row)
    
14.         For i = 2 To UBound(brr)
    
15.             For j = 2 To 13
    
16.                 x = brr(i, 1) & brr(1, j)
    
17.                 brr(i, j) = d(x)
    
18.                 S = S + d(x)
    
19.             Next
    
20.             If S > 0 Then brr(i, j) = S: S = 0
    
21.         Next
    
22.         .Range("B2:O" & .[b65536].End(3).Row) = brr
    
23.     End With
    
24. End Sub
    

复制代码

opelwang

grf1973 发表于 2017-6-1 10:42

如果我在32行，再加一個月份纍計，應該添加一句什麼代碼，請指點，謝謝！

yf_home

grf1973 发表于 2017-6-1 10:42

同问6楼的问题，谢谢。

grf1973

按列汇总，先用公式，再转成数值。

1. Sub zz()
   
2.     Dim d, arr, brr
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("明細").Range("A1:AT" & Sheets("明細").[b654321].End(3).Row)
   
5.     For i = 4 To UBound(arr)
   
6.         For j = 35 To 46
   
7.             x = arr(i, 2) & arr(3, j)
   
8.             d(x) = d(x) + arr(i, j)
   
9.         Next
   
10.     Next
    
11.     With Sheets("金額分析")
    
12.         .[C3:N32] = ""
    
13.         rmax = .[b65536].End(3).Row
    
14.         brr = .Range("B2:O" & rmax)
    
15.         For i = 2 To UBound(brr)
    
16.             For j = 2 To 13
    
17.                 x = brr(i, 1) & brr(1, j)
    
18.                 brr(i, j) = d(x)
    
19.                 S = S + d(x)
    
20.             Next
    
21.             If S > 0 Then brr(i, j) = S: S = 0
    
22.         Next
    
23.         .Range("B2:O" & .[b65536].End(3).Row) = brr
    
24.         .Cells(rmax + 1, 2) = "合计"
    
25.         .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1).Formula = "=sum(r2c:r[-1]c)"   '按月用公式计算
    
26.         .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1) = .Cells(rmax + 1, 3).Resize(1, UBound(brr, 2) - 1).Value  '公式换成数值
    
27.     End With
    
28. End Sub
    

复制代码