簡體   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