[已解决]去除重复项提取数据并叠加汇总

lidayu

请老师赐教如何实现以下要求，

B2=“数据源”B2:B,

B3=“数据源”C2:C,

B5:C5=“数据源”A2:A，

当满足以上条件去除“数据源”G2：G重复项提取到A6：A，

然后叠加汇总，B4:C=“数据源”F2:F

是根据满足条的数据量动态增减行数汇总，谢谢！
去重复项提取数据并叠加汇总.rar (56.03 KB, 下载次数: 43)

2017-9-3 20:38 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2017-9-4 10:25

小小修改一下，把D列的总计也一并放到sql里面。

跳转到最佳答案楼层

idnoidno

大哥，您的需求是，將數據源整理得到小單位匯總的兩個表格嗎

lidayu

idnoidno 发表于 2017-9-3 21:24
大哥，您的需求是，將數據源整理得到小單位匯總的兩個表格嗎

你好，不是要两个表，是A：D表得到的结果如F：I列表的效果，谢谢你的关注。

idnoidno

大哥，您的意思，是只要F:I的結果就可以，A:D是您已有的嗎

idnoidno

兩種顏色的部分匯總即可?

lidayu

idnoidno 发表于 2017-9-3 21:58
兩種顏色的部分匯總即可?

你好，颜色不是要参与计算，填充颜色是为了让老师更容易看清我想要的结果，如A：D的18、19、20行去除重复项后就成了F：I表的18行，数量是A：D表18、19、20的叠加数量，其它以此类推。

idnoidno

1. Sub t1()
   
2. Dim ar, br, i%, j%, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ar = Worksheets("T3").Range("a1").CurrentRegion
   
5. ReDim br(1 To UBound(ar, 1), 1 To UBound(ar, 2))
   
6. With Worksheets("t3")
   
7.     For i = 6 To UBound(ar)
   
8.        If Not d.exists(ar(i, 1)) Then
   
9.             j = j + 1
   
10.             d(ar(i, 1)) = j
    
11.             br(j, 1) = ar(i, 1)
    
12.        End If
    
13.     Next i
    
14.     For i = 1 To d.Count
    
15.         For j = 1 To UBound(ar)
    
16.             If br(i, 1) = ar(j, 1) Then
    
17.                 br(i, 2) = br(i, 2) + ar(j, 2)
    
18.                 br(i, 3) = br(i, 3) + ar(j, 3)
    
19.                 br(i, 4) = br(i, 4) + ar(j, 4)
    
20.             End If
    
21.         Next j
    
22.     Next i
    
23.     .[f6].Resize(UBound(br, 1), UBound(br, 2)) = br
    
24. End With
    
25. Set d = Nothing
    
26. End Sub

复制代码

請您把小單位匯總的工作表名稱改為T3，繁簡緣故，我的代碼無法呈現簡體
看看這樣是不是您要的結果

lidayu

idnoidno 发表于 2017-9-3 22:16
請您把小單位匯總的工作表名稱改為T3，繁簡緣故，我的代碼無法呈現簡體
看看這樣是不是您要的結果

你好，不是要这样的效果，数据来源是“数据源”表，还有A列的数据是要去重复后从“数据源”表G列提取过来的，请你点下小单位汇总表B2或B3你就明白我想要的结果是什么样呢？

lidayu

idnoidno 发表于 2017-9-3 22:16
請您把小單位匯總的工作表名稱改為T3，繁簡緣故，我的代碼無法呈現簡體
看看這樣是不是您要的結果

你好，请你把数据来源改为“数据源”表，汇总表的位置改为A：D列应该就对了。

idnoidno

所以您還是要從數據源得到兩個表，對吧