Question

利用Excel VBA功能令批注随单元格内容变化

各位大神，已查到可用Worksheet_change事件达到目的，可是找遍都没有详细的程序说明。拜托各位高人，请问是否可以提供一下详细的程序，以及简单说明。万分感谢！

Answer 1

以下是我做过的，随选中单元格不同而自动生成批注的程序，供你参考。

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim commenttext As String
ActiveSheet.Cells.ClearComments
Application.StatusBar = False
If Target.Count = 1 And Target.Row > 2 Then
If Len(Target.Value) > 0 Then
Target.AddComment
Target.Comment.Visible = True
If TypeName(Target.Value) <> "String" Then
commenttext = "选中的不是文本"
Else
commenttext = Target.Value
End If
Target.Comment.Text Text:=commenttext
Application.StatusBar = Left(Split(Target.Address(, False))(0), 1) & Target.Row & 单元格" & " 批注者：" & Application.UserName & " 批注内容：" & commenttext
Target.Comment.Shape.TextFrame.AutoSize = True
Target.Comment.Shape.TextFrame.Characters.Font.Name = "楷体"
Target.Comment.Shape.TextFrame.Characters.Font.Size = 14
Target.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 3
Target.Comment.Shape.TextFrame.Characters.Font.Bold = msoTrue
Else
Application.StatusBar = Left(Split(Target.Address(, False))(0), 1) & Target.Row & "单元格"
End If
End If
End Sub

追问

你好。谢谢！我提高悬赏了，能否麻烦你多一点点呢？
请问能否将操作步骤也告诉我一下呢？完全是菜鸟不懂用VBA的其实~真的不好意思了~
另外，不同的批注内容我应该写在哪里呢？其实想要的效果是，设置了下拉菜单，共12项内容，每选择一个不同的内容，会显示相应的批注。例如，内容是差旅费，批注为请留意说明1-3项；会议费，批注为请留意说明4-6项。谢谢！

Answer 2

这个很简单的：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Target.ClearComments   '删除原有批注
    Target.AddComment Target.Value   '添加批注
End Sub

追问

你好。麻烦你了，谢谢。按照VBA的说明，批注按照单元格下拉菜单内容的不同而变化，应该是用worksheet_change事件的吧？所以foxtiger回答的编码貌似不对啊~其实想要的效果是，设置了下拉菜单，共12项内容，每选择一个不同的内容，会显示相应的批注。例如，选择是差旅费，批注为请留意说明1-3项；再选择会议费时，批注则改为请留意说明4-6项。另外，不同的批注内容我应该写在哪里呢？谢谢！

追答

我给你写了一个测试样本，你只需要通过有效性的下拉菜单修改F5单元格的值即可！

变化后的批注会前台显示2秒钟后自动关闭。代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$F$5" Then Exit Sub
    Target.ClearComments      '删除原有批注
    
    Dim mStr As String
    mStr = Target.Validation.Formula1
    
    Dim arr, brr
    brr = Split(mStr, ",")
    arr = Array("请留意说明1-3项", _
                "请留意说明4-6项", _
                "3", _
                "4", _
                "5", _
                "6", _
                "7", _
                "8", _
                "9", _
                "10", _
                "11", _
                "12" _
                )
    Dim i As Long
    For i = 0 To UBound(brr)
        If Target.Value = brr(i) Then Exit For
    Next
    
    Target.AddComment(arr(i)).Visible = True  '添加批注
    
    
    Dim mTimer As Double    '让新加的批注显示两秒钟之后关闭！
    mTimer = Timer
    Do While mTimer + 2 > Timer
        DoEvents
    Loop
    
    Target.Comment.Visible = False
End Sub

Answer 3

1,启用宏

2,打开我这个附件

3, 维护B列C列的规则

4, 在表中任意的单元格,只要你输入的内容再B列出现,则同时将对应C列的内容作为批注增加到单元格中.你试试看是不是你想要的.

 

代码很简单,如下:

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
    If Target.Count > 1 Then Exit Sub
    For Each rg In ThisWorkbook.Worksheets(1).Range("B2:B" & CStr([B65535].End(xlUp).Row))
    If rg.Value = Target.Value Then
    
    Target.ClearComments
    Target.AddComment rg.Offset(0, 1).Value
    Exit Sub
    End If
     Next rg
    End Sub