[已解决]Excel怎样添加注解？

hayden5524

听说通过VBA可以实现Excel自动添加注解，特来请教，谢谢！
具体内容要求包括：
1.当该单元格有内容(数值不为0)时，自动在该单元格添加注解，注解内容来自于sheet1的D列
2.若sheet2中单元格的内容来自于sheet1的多个单元格，则把sheet1中每个单元格的内容都添加到该单元格的注解里
3.在注解内容的前面标上编写注解的日期

如附件：sheet2中的E2单元格不为0，根据函数，数值来自于sheet1中B2和B17,则在sheet2中的E2单元格添加注解，内容为sheet1中D2和D17的内容，最后，在注解前标上本次编写注解的日期。

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-9-25 18:05

hayden5524 发表于 2016-9-25 16:05
感谢您的解答，请收下我的膝盖
可是我还存在一些疑惑，就是在程序中，有些循环我不知道是啥意思 ...

'为了好理解，我直接用单元格写入
Sub test()
    Dim i As Integer, rw As Integer, col As Integer
    Dim d As Object

    Set d = CreateObject("Scripting.Dictionary") '创建字典，用法可以参考蓝版主的字典用法
    '###########################################################################################
    '将sheet1数据加入字典中
    With Sheet1
        For i = 2 To .Range("a65536").End(xlUp).Row 'sheet1表中从第二行开始到最后一行
            '用b列单元格合并上e列单元格作为字典的key，item则用chr(10)<换行符>合并所有符合的内容
            d(.Cells(i, "b") & "\" & .Cells(i, "e")) = d(.Cells(i, "b") & "\" & .Cells(i, "e")) & Chr(10) & .Cells(i, "f")
        Next i
    End With
    '############################################################################################
    For rw = 2 To Range("a2").End(xlDown).Row   'sheet2表格是从第二行开始，到最后一行
        For col = 3 To Range("a2").End(xlToRight).Column 'sheet2表格是从第3列开始，到最后一列
            If Cells(rw, col) <> 0 Then '用if判断单元格是否是0，不是则加批注进去
                '先判断单元格是否有批注，如果单元格没有批注则加批注
                If Cells(rw, col).Comment Is Nothing Then Cells(rw, col).AddComment
                '将内容加入批注中
                Cells(rw, col).Comment.Text Text:=Format(Date, "mm.dd") & d(Cells(rw, 1) & "\" & Cells(1, col))
                '将批注隐藏
                Cells(rw, col).Comment.Visible = False
            End If
        Next col
    Next rw
End Sub

跳转到最佳答案楼层

苏子龙

Sub tt()
    Dim arr, brr, i%, rw%, col%
    Dim dic As Object
    On Error Resume Next
    arr = Sheet2.UsedRange
    brr = Sheet1.UsedRange
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(brr)
        dic(brr(i, 1) & "\" & brr(i, 3)) = dic(brr(i, 1) & "\" & brr(i, 3)) & _
            Chr(10) & brr(i, 4)
    Next i
    For rw = 2 To UBound(arr)
      For col = 2 To 13
        If arr(rw, col) <> 0 Then
            Cells(rw, col).ClearComments: Cells(rw, col).AddComment
            Cells(rw, col).Comment.Text _
                Text:=Format(Date, "mm-dd") & dic(arr(rw, 1) & "\" & arr(1, col))
            Cells(rw, col).Comment.Visible = False
        End If
    Next col, rw
End Sub

su45

说得是批注吧？！

hayden5524

su45 发表于 2016-9-25 14:52
说得是批注吧？！

嗯，就是批注，可以请教下怎么做吗？谢谢！

hayden5524

苏子龙 发表于 2016-9-25 14:50
Sub tt()
    Dim arr, brr, i%, rw%, col%
    Dim dic As Object

感谢您的解答，请收下我的膝盖
可是我还存在一些疑惑，就是在程序中，有些循环我不知道是啥意思，比如说类似于"for i=1 to UBound(brr),(i,1),(i,3),char(10),(i,4),For rw = 2 To UBound(arr),For col = 2 To 13"这样含数字的，我不知道是从哪里开始循环到哪里结束，所以导致我在尝试增加或减少单元格记录的时候就会出错，如附件，所以，，可不可以请大神稍微点播一下这段程序的含义，以便于表格发生变化时我自己可以修改代码，万分感谢！

苏子龙

hayden5524 发表于 2016-9-25 16:05
感谢您的解答，请收下我的膝盖
可是我还存在一些疑惑，就是在程序中，有些循环我不知道是啥意思 ...

'为了好理解，我直接用单元格写入
Sub test()
    Dim i As Integer, rw As Integer, col As Integer
    Dim d As Object

    Set d = CreateObject("Scripting.Dictionary") '创建字典，用法可以参考蓝版主的字典用法
    '###########################################################################################
    '将sheet1数据加入字典中
    With Sheet1
        For i = 2 To .Range("a65536").End(xlUp).Row 'sheet1表中从第二行开始到最后一行
            '用b列单元格合并上e列单元格作为字典的key，item则用chr(10)<换行符>合并所有符合的内容
            d(.Cells(i, "b") & "\" & .Cells(i, "e")) = d(.Cells(i, "b") & "\" & .Cells(i, "e")) & Chr(10) & .Cells(i, "f")
        Next i
    End With
    '############################################################################################
    For rw = 2 To Range("a2").End(xlDown).Row   'sheet2表格是从第二行开始，到最后一行
        For col = 3 To Range("a2").End(xlToRight).Column 'sheet2表格是从第3列开始，到最后一列
            If Cells(rw, col) <> 0 Then '用if判断单元格是否是0，不是则加批注进去
                '先判断单元格是否有批注，如果单元格没有批注则加批注
                If Cells(rw, col).Comment Is Nothing Then Cells(rw, col).AddComment
                '将内容加入批注中
                Cells(rw, col).Comment.Text Text:=Format(Date, "mm.dd") & d(Cells(rw, 1) & "\" & Cells(1, col))
                '将批注隐藏
                Cells(rw, col).Comment.Visible = False
            End If
        Next col
    Next rw
End Sub