按条件批量添加批注

yunfei2018

  如题，按条件批量添加批注，该如何实现？谢谢！

   附件：    报表.zip (52.58 KB, 下载次数: 11)

2018-9-28 17:10 上传

点击文件名下载附件

//

alstar

1. Sub 批注()
   
2. Dim arr
   
3. arr = Sheets("呆滞标准").Range("c4:e" & Sheets("呆滞标准").Cells(Rows.Count, "e").End(xlUp).Row)
   
4.     For Each Rng In Range("o4:o" & Cells(Rows.Count, "o").End(xlUp).Row)
   
5.         For i = 1 To UBound(arr)
   
6.             If Rng = arr(i, 1) Then
   
7.             Rng.Offset(0, 1).ClearComments
   
8.             Rng.Offset(0, 1).AddComment.Text Text:="呆滞标准" & Chr(10) & arr(i, 3)
   
9.             Exit For
   
10.             End If
    
11.         Next
    
12.     Next
    
13. End Sub
    

复制代码

lsc900707

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("呆滞标准")
   
4.         r = .Cells(.Rows.Count, 3).End(3).Row
   
5.         arr = .Range("c4:e" & r)
   
6.         For i = 1 To UBound(arr)
   
7.             d(arr(i, 1)) = arr(i, 3)
   
8.         Next
   
9.     End With
   
10.     brr = Range("o4:p" & Cells(Rows.Count, 15).End(3).Row)
    
11.     For i = 1 To UBound(brr)
    
12.         If d.Exists(brr(i, 1)) Then
    
13.             Cells(i + 3, 16).ClearComments
    
14.             Cells(i + 3, 16).AddComment.Text Text:="呆滞标准期限" & Chr(10) & d(brr(i, 1))
    
15.         End If
    
16.     Next
    
17. End Sub

复制代码

lsc900707

附件供测试：

yunfei2018

alstar 发表于 2018-9-28 19:32

经测试，可以达到效果，数组+循环方法，学习了，

yunfei2018

lsc900707 发表于 2018-9-28 21:44

通过字典判断是否存在，然后进行添加，好方法，学习了。