[已解决]使用VBA获取相关数据到批注

luchao124

求高手帮忙  对于没有达到起订量的货号（起订量达成率小于100%），在明细表中获取订货网点和订货数量 到批注中    详细请见附件 使用VBA获取相关数据到批注.rar (12.76 KB, 下载次数: 7) 2017-8-16 21:04 上传 点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

chart888

2017-8-19 08:29

luchao124 发表于 2017-8-18 20:47
谢谢 你的回答  不过有点小问题  第一次运行没有问题，第二次运行就报错  需要删掉所有的批注再运行才行
...

修改了下

跳转到最佳答案楼层

chart888

luchao124 发表于 2017-8-18 20:47
谢谢 你的回答  不过有点小问题  第一次运行没有问题，第二次运行就报错  需要删掉所有的批注再运行才行
...

修改了下

chart888

1. Sub test()
   
2.     Dim Arr, Brr, Crr
   
3.     Dim k, i, j
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Arr = Worksheets("明细表").[A1].CurrentRegion
   
6.     Brr = Worksheets("汇总表").[A1].CurrentRegion
   
7.     ReDim Crr(1 To UBound(Arr), 1 To 1)
   
8.     For i = 2 To UBound(Arr)
   
9.         If d.exists(Arr(i, 2)) Then
   
10.             m = d(Arr(i, 2))
    
11.             Crr(m, 1) = Crr(m, 1) & vbCrLf & Arr(i, 1) & ":" & Arr(i, 4)
    
12.         Else
    
13.             k = k + 1
    
14.             d(Arr(i, 2)) = k
    
15.             Crr(k, 1) = Arr(i, 1) & ":" & Arr(i, 4)
    
16.         End If
    
17.     Next
    
18.     For j = 3 To UBound(Brr)
    
19.         If Val(Brr(j, 5)) < 1 Then
    
20.             n = d(Brr(j, 1))
    
21.             With Worksheets("汇总表").Cells(j, 6)
    
22.                 If Not .Comment Is Nothing Then .Cells(j, 6).Comment.Delete
    
23.                 .AddComment
    
24.                 .Comment.Text Text:=Crr(n, 1)
    
25.                 .Comment.Visible = True
    
26.                 .Comment.Shape.TextFrame.AutoSize = True
    
27.             End With
    
28.         End If
    
29.     Next
    
30. End Sub

复制代码

hhzjxss

看过了，是提取明细数据到汇总表中！

luchao124

chart888 发表于 2017-8-17 09:37

谢谢 你的回答  不过有点小问题  第一次运行没有问题，第二次运行就报错  需要删掉所有的批注再运行才行