Question

请大家帮我看看这对VBA代码如何改进

要求：

当D5 内容为Return to client， 自动添加备注，
当内容为Discard after 3 weeks，删除备注
内容为MQ test sample will keep for 6 months，删除备注
现在可以实现功能，但是当D5为Return to client时，总是自动添加备注，麻烦大家帮我改下代码，谢谢

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("D5").Value = "Return to client" Then
'加入原内容有备注，先消除
Range("D5").ClearComments
Range("D5").AddComment
Range("D5").Comment.Visible = True
Range("D5").Comment.Text Text:="Please take test samples back within 3weeks after you received test report." & Chr(10) & ""
Range("D5").Comment.Shape.Select True
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End If

If Range("D5").Value = "Discard after 3 weeks" Then

Selection.ClearComments
End If
If Range("D5").Value = "MQ test sample will keep for 6 months" Then

Selection.ClearComments
End If

End Sub

Answer 1

If Range("D5").Value = "Discard after 3 weeks" Then
Selection.ClearComments ‘改成Range("D5").ClearComments
End If
If Range("D5").Value = "MQ test sample will keep for 6 months" Then
Selection.ClearComments ' 改成Range("D5").ClearComments
End If

追问

我按照以上把程序改了，但是当D5为Return to client时，D5还是自动添加备注，也就是说添加备注成功后，只要我点击其他任何单元格，D5总是自动再次添加一个备注，如何将这个毛病去除，我怀疑是第一段代码有问题，麻烦帮我看看

追答

If Range("D5").Value = "Return to client" Then
在这句之前加上一句：
If Target.Row 5 Or Target.Column 4 then exit sub

追问

不好意思，还是有点小BUG,因为加了Target后，只有再次点选D5才可以出现备注，直接点击其他单元格，D5是不会出现备注的。我希望的是D5内容为Return to client后，备注会自动弹出，而且可以去做其他单元格工作了，感谢！

追答

OK,那不加target了，If Range("D5").Value = "Return to client" Then这句改为：
If Range("D5").Value = "Return to client" and Range("D5").Comment.Text"Please take test samples back within 3weeks after you received test report." & Chr(10) & "" then

Answer 2

把代码写到事件Change里，不要在Select里

Private Sub Worksheet_Change(ByVal Target As Range)

代码......

End Sub