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

lidayu

idnoidno 发表于 2017-9-3 22:55
所以您還是要從數據源得到兩個表，對吧

你好，只要一个A：D列的表，A：D列表动态增减数据已实现了，就差两个要求，1、把A6：A数据去重复，2、把统一区域B6：C改为叠加汇总就好了，F：I的表格是让你参照的。

idnoidno

大哥，不好意思，您解釋我還是有點迷糊，我給您的代碼可以執行得到您的小單位匯總的右邊表格(您的紅色字，要的結果的數字)，您需要把右邊的表格的一些文字都讓代碼得到嗎，如果是，那就我來添加

idnoidno

號型我已經在代碼中取得，只是沒有讓它寫出到表格(因為您的表格已經有列出)，假如您的需求是要右邊的表格在代碼執行後產生，那就容易多了

idnoidno

論壇時間快要到了，若是我的理解是ˋ對的，明早我調整一下代碼就可以給您，若是沒有落差，您不嫌麻煩，可以再給我點說明，以便我可以協助您完成您的需求，晚安

lidayu

idnoidno 发表于 2017-9-3 23:47
論壇時間快要到了，若是我的理解是ˋ對的，明早我調整一下代碼就可以給您，若是沒有落差，您不嫌麻煩，可以 ...

你好
统一回复如下问题
1、大哥，不好意思，您解釋我還是有點迷糊，我給您的代碼可以執行得到您的小單位匯總的右邊表格(您的紅色字，要的結果的數字)，
您需要把右邊的表格的一些文字都讓代碼得到嗎，如果是，那就我來添加
2、號型我已經在代碼中取得，只是沒有讓它寫出到表格(因為您的表格已經有列出)，
假如您的需求是要右邊的表格在代碼執行後產生，那就容易多了
1-1、想要的结果表实际位置就是A：D列，F：I列只是让你知道我要在A：D列得到的效果与F：I表一样。
1-2、想要代码运行取得不重复的“号型“放在A6：A、“品种名称”放在B5：C5
2-1、不是右边表格，是要在左边表格，右边表格只是参照样式。

idnoidno

不好意思囉，我的理解的有落差，不過代碼您可以參考一下

grf1973

彻底换个思路，用数据库做吧，便于理解，以后也好修改一点。

grf1973

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

lidayu

grf1973 发表于 2017-9-4 10:25
小小修改一下，把D列的总计也一并放到sql里面。

grf1973老师您好，很好就是要这样效果，能不能不把这
    tj = .....
    Sql = ......
    Sql = ......
写在代码中，这样太很深奥不容易理解。
谢谢！

idnoidno

1. Sub t1()
   
2. Dim ar, br, cr, i%, j%, k%, irow%
   
3. ar = Worksheets("T1").Range("a1").CurrentRegion
   
4. ReDim br(1 To UBound(ar, 1), 1 To 4)
   
5. With Worksheets("T2")
   
6.     For i = 2 To UBound(ar)
   
7.         If ar(i, 1) = .Cells(5, 2) Then
   
8.             If ar(i, 2) = .Cells(2, 2) Then
   
9.                 If ar(i, 3) = .Cells(3, 2) Then
   
10.                     j = j + 1
    
11.                     br(j, 1) = ar(i, 7): br(j, 2) = ar(i, 6)
    
12.                 End If
    
13.             End If
    
14.         ElseIf ar(i, 1) = .Cells(5, 3) Then
    
15.             If ar(i, 2) = .Cells(2, 2) Then
    
16.                 If ar(i, 3) = .Cells(3, 2) Then
    
17.                     j = j + 1
    
18.                     br(j, 1) = ar(i, 7): br(j, 3) = ar(i, 6)
    
19.                 End If
    
20.             End If
    
21.         End If
    
22.     Next i
    
23.    
    
24.     .[a6].Resize(UBound(br, 1), 4) = br
    
25.     irow = .[a65536].End(xlUp).Row
    
26.     For i = 6 To irow
    
27.         .Cells(irow + 1, 2) = .Cells(irow + 1, 2) + .Cells(i, 2)
    
28.         .Cells(irow + 1, 3) = .Cells(irow + 1, 3) + .Cells(i, 3)
    
29.         .Cells(i, 4) = .Cells(i, 4) + .Cells(i, 2) + .Cells(i, 3)
    
30.     Next i
    
31. End With
    
32. End Sub

复制代码