VBA Excel Поиск комментариев - PullRequest
Новая
       15

VBA Excel Поиск комментариев

0 голосов
/ 17 октября 2018

У меня есть несколько списков проверки данных в ячейках L6:U6.Они все в одном списке.Список поступает из диапазона BD3:BD15 и находится в алфавитном порядке.В ячейках BE3:BE15 у меня есть комментарии относительно различных предметов, которые появляются в моем раскрывающемся списке.Что я ищу, так это когда элемент выбран в любой из моих ячеек проверки данных, чтобы комментарий был vlookup'ed из диапазона BD3:BE15.Так, например, вы выбираете слово «Burn» в выпадающем списке или ячейке L6, и будет выполняться vlookup с диапазоном 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

1 Ответ

0 голосов
/ 17 октября 2018

Есть проблема с вашим 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
...