VBA Excel 评论查找
VBA Excel Comment Lookup
我在单元格 L6:U6
中有几个数据验证列表。它们都是相同的列表。该列表来自 BD3:BD15
范围,并按字母顺序排列。在单元格 BE3:BE15
中,我对下拉列表中出现的不同项目发表了评论。我正在寻找的是当一个项目在我的任何数据验证单元格中被 selected 时,评论将从范围 BD3:BE15
中被 vlookup'ed。因此,例如,您 select 下拉列表或单元格 L6
中的单词 "Burn",将使用范围 BD3:BE15
进行 vlookup 以提取与如何当您将鼠标悬停在单元格 L6
上时,会出现烧伤治疗。
这是我想出的代码,但是当我 运行 它时,我遇到了一些问题。我收到 运行 次错误“1004”:应用程序定义或对象定义的错误。我点击确定,评论只出现在单元格 L6:N6
上。对于我收到的评论,我看不到整个字符串,它被屏幕外的几个单词截断了。当我 select 一个不同的项目时,比如 "Poison" 这个词,评论也不会更新。有人可以查看我的代码并告诉我哪里出错了吗?
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:$U")
Set lookRange = Range("$BD:$BE")
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()
table 中没有条目,它将出错。一种快速解决方案是稍微调整代码:
On Error Resume Next
.Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
On Error GoTo 0
另一种方法是提示用户添加缺失的 value/return 值,但这有点复杂,如果没有 [=],我不确定你想要什么 return 12=] 找到条目。
编辑:这里包含一些错误处理。如果没有单元格值条目,它将展开 VLOOKUP table:
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:$U") 'Define our ranges
Set lookRange = Range("$BD:$BE")
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:$BE$" & .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Row)
End With
Resume Next
End Sub
我在单元格 L6:U6
中有几个数据验证列表。它们都是相同的列表。该列表来自 BD3:BD15
范围,并按字母顺序排列。在单元格 BE3:BE15
中,我对下拉列表中出现的不同项目发表了评论。我正在寻找的是当一个项目在我的任何数据验证单元格中被 selected 时,评论将从范围 BD3:BE15
中被 vlookup'ed。因此,例如,您 select 下拉列表或单元格 L6
中的单词 "Burn",将使用范围 BD3:BE15
进行 vlookup 以提取与如何当您将鼠标悬停在单元格 L6
上时,会出现烧伤治疗。
这是我想出的代码,但是当我 运行 它时,我遇到了一些问题。我收到 运行 次错误“1004”:应用程序定义或对象定义的错误。我点击确定,评论只出现在单元格 L6:N6
上。对于我收到的评论,我看不到整个字符串,它被屏幕外的几个单词截断了。当我 select 一个不同的项目时,比如 "Poison" 这个词,评论也不会更新。有人可以查看我的代码并告诉我哪里出错了吗?
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:$U")
Set lookRange = Range("$BD:$BE")
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()
table 中没有条目,它将出错。一种快速解决方案是稍微调整代码:
On Error Resume Next
.Comment.Text Text:=CStr(WorksheetFunction.VLookup(c, lookRange, 2, False))
On Error GoTo 0
另一种方法是提示用户添加缺失的 value/return 值,但这有点复杂,如果没有 [=],我不确定你想要什么 return 12=] 找到条目。
编辑:这里包含一些错误处理。如果没有单元格值条目,它将展开 VLOOKUP table:
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:$U") 'Define our ranges
Set lookRange = Range("$BD:$BE")
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:$BE$" & .Cells(.Rows.Count, .Columns.Count).Offset(1, 0).Row)
End With
Resume Next
End Sub