繁体   English   中英

VBA Excel 注释查找

[英]VBA Excel Comment Lookup

我在单元格L6:U6有几个数据验证列表。 它们都是相同的列表。 该列表来自BD3:BD15范围, BD3:BD15字母顺序排列。 在单元格BE3:BE15我对下拉列表中出现的不同项目进行了评论。 我正在寻找的是,当在我的任何数据验证单元格中选择一个项目时,评论将从范围BD3:BE15 因此,例如,您在下拉列表或单元格L6选择单词“Burn”,将使用范围BD3:BE15以拉出与如何治疗烧伤相关的评论,当您将鼠标悬停在单元格L6时将出现。

这是我想出的代码,但是当我运行它时,我遇到了一些问题。 我收到运行时错误“1004”:应用程序定义或对象定义错误。 我没问题,评论只出现在单元格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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM