VBA Excel注释查找

我在单元格中有几个数据验证列表

L6:U6

。它们都是同一个列表。该列表来自范围

BD3:BD15

，按字母顺序排列。在单元格

BE3:BE15

中，我对下拉列表中显示的不同项目有注释。我要寻找的是，当在我的任何数据验证单元格中选择一个项目时，注释将从范围

BD3:BE15

中删除。例如，您在下拉列表或单元格

L6

中选择单词“Burn”，然后将使用range

BD3:BE15

执行vlookup操作，以在您将鼠标悬停在单元格

L6

上时提取与如何处理烧伤相关的注释

下面是我编写的代码，但当我运行它时，遇到了一些问题。我得到一个运行时错误“1004”：应用程序定义的或对象定义的错误。我点击OK，注释只出现在单元格

L6:N6

上。对于我得到的评论，我看不到整个字符串，它被屏幕上的几个单词切断。当我选择一个不同的项目时，比如“毒药”，评论也不会更新。有人能检查一下我的代码，告诉我哪里出了问题吗

Sub CommentLookup()
'Range where you want to add comments to
Dim commentRange As Range
Dim c As Range
'Range to lookup
Dim lookRange As Range
'Define our ranges
Set commentRange = Range("$L$6:$U$6")
Set lookRange = Range("$BD$3:$BE$15")
Application.ScreenUpdating = True
'loop through and comment
For Each c In commentRange
    With c
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
        .Comment.Shape.TextFrame.AutoSize = False
    End With
Next c
Application.ScreenUpdating = True
End Sub

---

您的

VLOOKUP（）

有问题。如果您的单元格在

VLOOKUP（）

表中没有条目，它将出错。一个快速解决方案是稍微调整代码：

On Error Resume Next
.Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
On Error GoTo 0

另一种方法是提示用户添加缺少的值/返回值，但这需要更多的时间，如果没有找到

VLOOKUP（）

条目，我不确定您想要返回什么

编辑：这里包含一些错误处理。如果没有单元格值的条目，它将展开VLOOKUP表：

Option Explicit

Sub CommentLookup()
Dim commentRange As Range 'Range where you want to add comments to
Dim c As Range
Dim lookRange As Range     'Range to lookup
Set commentRange = Range("$L$6:$U$6")     'Define our ranges
Set lookRange = Range("$BD$3:$BE$15")    
Application.ScreenUpdating = False
For Each c In commentRange 'loop through and comment
    With c
        c.Select
        .ClearComments
        .AddComment
        .Comment.Visible = False
        On Error GoTo tableAdd
        .Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
        On Error GoTo 0
        .Comment.Shape.TextFrame.AutoSize = False
    End With
Next c
Application.ScreenUpdating = True
Exit Sub

tableAdd:
Dim entry As String
entry = InputBox("What is the expected return value for " & c.Value)
With lookRange
    .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Value = entry
    .Cells(.Rows.Count, 1).Offset(1, 0).Value = c
    Set lookRange = Range("$BD$3:$BE$" & .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Row)
End With
Resume Next

End Sub

---

哪一行抛出了错误？我不确定。我想我的问题在于.Comment.Shape.TextFrame.AutoSize=False、.Comment.Text:=CStr（WorksheetFunction.VLookup（c，lookRange，2，False））和Application.screenUpdate=true。您应该将ScreenUpdate设置为Falsecough@Marcucciboy2-可能。OP把它写成了

真的

，所以我就把它留下了。他还提到他在这方面遇到了麻烦