求助根据产品和两列单元值计算的VBA

510437958

1、根据数据源的AP列、BN列组成VBA表的B列，暨数据源表格的BN列单元格值&"（"AP列单元格值&"）"组成VBA列的B列单元格值。如表中的快乐中餐厅的AP列、BN列值分别为"二公司"、"腾飞镇",组成VBA表格的"腾飞镇（二公司）"
2、数据源的AH列不为空则统计为征收数，数据源的BB列不为空则统计为入库数，征收-入库=在途。如数据源表中的天诚小额信贷公司，各项征收数为114296.58，而入库数为0，
3、数据源表的C列对应VBA表的第二行，空白处为预留新产品收入。
4、VBA表的D列等于E列到V列的和，W列等于X列到AK列的和，C列等于E列+W列
要求：
1、在OFFICE2003可以实现；
2、如新增产品超过预留空白列，插入列并复制超过的新的产品名称依然可以计算；例如2017年有11个新产品投产，插入2列以后会自动汇总计算，在第二行复制新的产品名称，主业收入和副业收入的合计数包括总计数那一列不要求计算准确。
3、支持负数运算，暨产品有退换货收入
4、数据源最后一行合计行不参与计算。
5、当开票日期和回款日期在同一年和月，征收=入库；根据收入归属分产品来汇总。希望运算时间在2-3分钟以内。
6、数据在3万行到4万行之间，收入归属有22个，产品品种有23个，预留了9个
7、要求根据AH列开票日期整理成VBA表A列日期年月格式

510437958

论坛的网友们，这个VBA应该不难吧？我一直都在期待着你们的指导和帮助。VBA如果能写上简单的中文注释就更好了，有愿意私聊的请加我QQ510437958，谢谢！或者留下您的联系方式。

skyzxh

AH列和BB列均不为空时，算征收？还是入库？。。。。。。。。描述和表格不完全一致

510437958

skyzxh 发表于 2016-5-17 22:54
AH列和BB列均不为空时，算征收？还是入库？。。。。。。。。描述和表格不完全一致

AH列和BB列均不为空时，就是征收和入库都算，暨征收数=入库数（暨在途数为0）；AH列不为空且BB列为空，表示征收数=在途数（暨入库数为0）。不知道这样解释是否清楚，谢谢skyzxh老师的关注。

准提部林

匯總條件確認：
１．AH列或BB列有日期，即記錄成３行（征收数．入库数．在途数）？
２．以〔AH月份＋AP列＋BN列〕為索引條件加總在一起，同月份可能有多筆？
　
每筆記錄成３筆，４萬行就可能達１２萬行？

510437958

准提部林 发表于 2016-5-18 10:41
匯總條件確認：
１．AH列或BB列有日期，即記錄成３行（征收数．入库数．在途数）？
２．以〔AH月份＋AP列 ...

准提老师，不是这样的，是根据数据源表的BN列和数据源表的AP列组合来归类产品，一般组合下来的就是20多个组合，再乘以3就是60多条征收、入库、在途，再次为我的描述不准确而致歉。老师，你们的眼光总是那么独到！谢谢您对我的问题的关注，再次感谢！

准提部林

若AH列及BB列日期〔不同月份〕, 如何認定?
或.AH列〔無日期〕，而BB列〔有日期〕，又如何？
BN列和AP列组合有無可能很多筆？
若同組合存在很多筆，且〔年．月份〕不同，又如何歸屬？
　
　

准提部林

只能以摸擬結果當參考寫，以初入VBA者而言不算容易，
繁簡文字在VBE無法相容，僅能如下參考，也無法再進一步說明：

1. Sub TEST()
   
2. Dim xD, A As Range, C%, ClmnCunt%, TL1%, TL2%
   
3. Set xD = CreateObject("Scripting.Dictionary")
   
4. With Sheets("VBA").UsedRange
   
5. 　　.Offset(2, 0).EntireRow.Delete '清除原資料
   
6. 　　For Each A In .Rows(2).Cells '第２行標題（事先須手動輸入）
   
7. 　　　　C = A.Column
   
8. 　　　　If A <> "" Then xD(A.Value) = C '記錄〔產品〕所在〔列號〕
   
9. 　　　　If A = "Total" Then If TL1 = 0 Then TL1 = C Else TL2 = C '記錄〔合計〕的〔列號〕
   
10. 　　Next
    
11. 　　ClmnCunt = .Columns.Count '〔列〕總數
    
12. End With
    
13. 
    
14. Dim Arr, Brr, i&, j%, D(2), T$, R&, N&, U%
    
15. Arr = Sheets("Sheet1").UsedRange
    
16. ReDim Brr(1 To UBound(Arr), 1 To ClmnCunt)
    
17. For i = 4 To UBound(Brr)
    
18. 　　D(0) = Arr(i, [AH1].Column) '開具日期
    
19. 　　D(1) = Arr(i, [BB1].Column) '入庫日期
    
20. 　　If D(0) = "" And D(1) = "" Then GoTo 101
    
21. 　　D(2) = IIf(D(0) = "", D(1), D(0))
    
22. 　　C = xD(Arr(i, 3)): If C = 0 Then GoTo 101 '取得〔產品〕列號
    
23. 　　U = IIf(C > TL2, TL2, TL1) '取得〔合計〕列號
    
24. 
    
25. 　　T = Arr(i, [BN1].Column) & "(" & Arr(i, [AP1].Column) & ")" '〔鄉鎮．公司〕名稱
    
26. 　　R = xD(T)
    
27. 　　If R = 0 Then xD(T) = N + 1: R = N + 1: N = N + 3
    
28. 
    
29. 　　For j = 0 To 2
    
30. 　　　　Brr(R + j, 1) = Format(Split(D(2) & " ", " ")(0), "yyyy/m/1")
    
31. 　　　　Brr(R + j, 2) = Array("A", "B", "C")(j) 'A〔征收〕，B〔入庫〕．C〔在途〕
    
32. 　　　　Brr(R + j, 3) = T
    
33. 　　　　If j < 2 And D(j) <> "" Then
    
34. 　　　　　　Brr(R + j, C) = Brr(R + j, C) + Arr(i, [I1].Column) '產品數量
    
35. 　　　　　　Brr(R + j, U) = Brr(R + j, U) + Arr(i, [I1].Column) '合計數量
    
36. 　　　　　　Brr(R + j, 4) = Brr(R + j, 4) + Arr(i, [I1].Column) '總計數量
    
37. 　　　　End If
    
38. 　　Next
    
39. 
    
40. 　　Brr(R + 2, C) = Brr(R, C) - Brr(R + 1, C) '在途產品數量
    
41. 　　Brr(R + 2, U) = Brr(R, U) - Brr(R + 1, U) '在途合計數量
    
42. 　　Brr(R + 2, 4) = Brr(R, 4) - Brr(R + 1, 4) '在途總計數量
    
43. 101: Next i
    
44. 
    
45. If N = 0 Then Exit Sub
    
46. With Sheets("VBA").[A3].Resize(N, ClmnCunt)
    
47. 　　.Value = Brr
    
48. 　　.Replace 0, "", Lookat:=xlWhole
    
49. 　　.Borders.LineStyle = 1
    
50. End With
    
51. End Sub

复制代码

　
20160517VBA_v01.rar (17.91 KB, 下载次数: 26)

2016-5-22 12:07 上传

点击文件名下载附件

　
　

TTZXX2016

准提部林 发表于 2016-5-18 10:41
匯總條件確認：
１．AH列或BB列有日期，即記錄成３行（征收数．入库数．在途数）？
２．以〔AH月份＋AP列 ...

准提部林老师您好：您对VBA也非常精通，麻烦老师帮我看一下链接上的问题，看代码能不能再简洁一些，拜托了。
http://club.excelhome.net/thread-1279196-1-1.html

510437958

准提部林 发表于 2016-5-22 12:08
只能以摸擬結果當參考寫，以初入VBA者而言不算容易，
繁簡文字在VBE無法相容，僅能如下參考，也無法再進一 ...

非常感谢准提老师的帮助。