用字典实现月度数据累计汇总的问题

杨宝明

我想使用字典实现将分月分客户各产品的发运情况汇总到一个累计表里，但没有成功，估计是我对字典赋值方面有问题，初学者找不到是什么原因，请大师帮我修改一下，不胜感谢！

1. Private Sub CommandButton1_Click()
   
2. Dim arr, brr, crr
   
3. Dim i&, r, r1, str, str1
   
4. Dim dic As Object
   
5. Set dic = CreateObject("scripting.dictionary")
   
6. For i = 1 To 6
   
7.     With Sheets(CStr(i) & "月")
   
8.     r = .[A65536].End(xlUp).row
   
9.     For j = 5 To r
   
10.         str = .Range("a" & j).Value
    
11.         arr = .Range("b" & j & ":" & "i" & j)
    
12.         If Not dic.exists(str) Then
    
13.             dic.Add str, arr
    
14.         Else
    
15.            crr = dic(str).Item
    
16.            arr = arr + crr
    
17.            dic(str) = arr
    
18.         End If
    
19.     Next j
    
20.     End With
    
21. Next i
    
22. 
    
23. With Sheets("累计")
    
24.     r1 = .[A65536].End(xlUp).row
    
25.     For i = 5 To r1
    
26.         str1 = .Range("a" & j).Value
    
27.         brr = dic(str1)
    
28.         .Cells(i, 2).Resize(1, 8) = brr
    
29.     Next
    
30. End With
    
31. Set dic = Nothing
    
32. End Sub

复制代码

LMY123

同薄多表合并后，再分类汇总

杨宝明

LMY123 发表于 2018-7-16 10:37
同薄多表合并后，再分类汇总

怎么合并？“同薄多表合并”我理解不了，小白一枚。

LMY123

杨宝明 发表于 2018-7-16 10:58
怎么合并？“同薄多表合并”我理解不了，小白一枚。

http://club.excelhome.net/forum.php?mod=viewthread&tid=770549

jiangxiaoyun

1. Sub vf()
   
2.     Dim arr, brr(1 To 1000, 1 To 10)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sht In Sheets
   
5.         If sht.Name Like "*月" Then
   
6.             With sht
   
7.                 r = .Cells(Rows.Count, 1).End(xlUp).row
   
8.                 arr = .Range("a4:j" & r)
   
9.             End With
   
10.             For i = 1 To UBound(arr)
    
11.                 If Not d.exists(arr(i, 1)) Then
    
12.                     k = k + 1
    
13.                     d(arr(i, 1)) = k
    
14.                     For j = 1 To UBound(arr, 2)
    
15.                         brr(k, j) = arr(i, j)
    
16.                     Next
    
17.                 Else
    
18.                     For j = 2 To UBound(arr, 2)
    
19.                         brr(d(arr(i, 1)), j) = brr(d(arr(i, 1)), j) + arr(i, j)
    
20.                     Next
    
21.                 End If
    
22.             Next
    
23.         End If
    
24.     Next
    
25.     Sheets("累计").[a4].Resize(k, UBound(brr, 2)) = brr
    
26. End Sub
    

复制代码

jiangxiaoyun

2018年发运量汇总.rar (42.65 KB, 下载次数: 192)

2018-7-16 14:35 上传

点击文件名下载附件

杨宝明

jiangxiaoyun 发表于 2018-7-16 14:34

代码基本看懂了，思路很强大，谢谢。