希望按品番和月份汇总数据后，在对应单元格自动生成批注并在批注中显示对应的日期...

nihao8026

希望按品番和月份汇总数据后，在对应单元格自动生成批注并在批注中显示对应的日期和数量

拜托各位大神 谢谢！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   Set d1 = CreateObject("scripting.dictionary")
   
7.   With Worksheets("数据1")
   
8.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.     arr = .Range("a2:d" & r)
   
10.     n = 2
    
11.     For i = 1 To UBound(arr)
    
12.       yf = Month(arr(i, 3))
    
13.       If Not d1.exists(yf) Then
    
14.         n = n + 1
    
15.         d1(yf) = n
    
16.       End If
    
17.     Next
    
18.     For i = 1 To UBound(arr)
    
19.       xm = arr(i, 1) & "+" & arr(i, 2)
    
20.       If Not d.exists(xm) Then
    
21.         ReDim brr(1 To 2, 1 To 2 + d1.Count)
    
22.         brr(1, 1) = arr(i, 1)
    
23.         brr(1, 2) = arr(i, 2)
    
24.       Else
    
25.         brr = d(xm)
    
26.       End If
    
27.       yf = Month(arr(i, 3))
    
28.       n = d1(yf)
    
29.       brr(1, n) = brr(1, n) + arr(i, 4)
    
30.       If IsEmpty(brr(2, n)) Then
    
31.         brr(2, n) = arr(i, 3) & Space(2) & arr(i, 4)
    
32.       Else
    
33.         brr(2, n) = brr(2, n) & vbLf & arr(i, 3) & Space(2) & arr(i, 4)
    
34.       End If
    
35.       d(xm) = brr
    
36.     Next
    
37.   End With
    
38.   With Worksheets("汇总")
    
39.     .Cells.Clear
    
40.     .Range("a1:b1") = Array("品番", "名称")
    
41.     .Range("c1").Resize(1, d1.Count) = d1.keys
    
42.     m = 1
    
43.     For Each aa In d.keys
    
44.       m = m + 1
    
45.       brr = d(aa)
    
46.       .Cells(m, 1).Resize(1, UBound(brr, 2)) = Application.Index(brr, 1, 0)
    
47.       For j = 3 To UBound(brr, 2)
    
48.         If Not IsEmpty(brr(2, j)) Then
    
49.           .Cells(m, j).AddComment
    
50.           .Cells(m, j).Comment.Text Text:=brr(2, j)
    
51.         End If
    
52.       Next
    
53.     Next
    
54.   End With
    
55. End Sub
    

复制代码

chxw68

详见附件。

nihao8026

chxw68 发表于 2018-7-18 11:19
详见附件。

非常感谢大神的回复，就是我想要的功能。
希望您能否将汇总表中的月份显示为“8月” “9月”这样子吗？不显示为8、9

拜托了！！

chxw68

详见附件。

nihao8026

chxw68 发表于 2018-7-18 11:39
详见附件。

数据可以了，非常感谢！！