VBA Range.find ошибки (не xlPart find и объектная переменная не установлена ​​ошибка)

Question

Я начинаю VBA, пытаюсь переделать какой-то код из полезного автора, у меня возникла какая-то проблема, и я надеюсь, что вы сможете мне помочь ,

У меня есть строки комментариев на одном листе (DATA2) и ключевые слова в другом (КЛЮЧЕВЫЕ СЛОВА). Моя цель - поиск по комментариям и присвоение им категории, если найдено одно из ключевых слов.

Код ниже работает, как хотелось бы, при некоторых значениях (Data = Eric Keyword = Eric). Однако при других значениях возникает ошибка «Ошибка переменной объекта», я предполагаю, что значение не найдено (Data=Ericlikespie Keyword = Eric OR Data=Emi No Keyword).

Любые указатели были бы полезны. Я просмотрел предыдущие ответы, но большинство из них, похоже, связано с проблемой набора. Я понимаю, что все это можно сделать вручную с условным форматированием или с большой формулой index + search, но я ищу что-то лучшее.

Sub Trail() 

'DECS 
Dim ws As Worksheet, Map As Worksheet 
Dim MapRange As range, UpdateRange As range, aCell As range, bCell As range 
On Error GoTo Err 

'DEFS 
Set ws = Worksheets("DATA2") 
Set Map = Worksheets("KEYWORDS") 
Set UpdateRange = ws.range("K:K") 
Set MapRange = Map.range("A:A") 

'COMPS 
For Each aCell In UpdateRange 
    Set bCell = MapRange.Find(What:=aCell, LookIn:=xlValues, _ 
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False) 
    If Not bCell Is Nothing Then 
     aCell.Offset(0, -1) = bCell.Offset(0, 1) 
    End If 
Next 

Exit Sub 
Err: 
MsgBox Err.Description 

End Sub 

Answer 1

Я решил вопрос с кода ниже. Таблица поиска и целевая таблица были включены в оператор Range.Find. Это вызывало точные совпадения для работы, но частичные (то, что я собирался) терпеть неудачу, независимо от синтаксиса кода.

Я также добавил в цикл FindNext для поиска всех вхождений каждого ключевого слова, изменил обработку ошибок, чтобы иметь дело с несоответствиями, и теперь код работает как ожидалось.

Private Sub CommandButton3_Click() 


    Dim ws As Worksheet 
    Dim DataRange As Range, UpdateRange As Range, aCell As Range, bCell As Range 
    Dim cCell As Range 
    Dim keeper As Range 


    On Error Resume Next 
    Set ws = Worksheets("Sheet1") 
    Set UpdateRange = ws.Range("A1:A8") 
    Set DataRange = ws.Range("H1:H4") 

For Each aCell In DataRange 
    Set bCell = UpdateRange.Find(What:=aCell.Value, LookIn:=xlValues, LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
    , SearchFormat:=False) 

If Not bCell Is Nothing Then 
    Set keeper = bCell 
    bCell.Offset(0, 1) = aCell.Offset(0, 1) 

     Do 
      Set bCell = UpdateRange.FindNext(After:=bCell) 

      If Not bCell Is Nothing Then 
       If bCell.Address = keeper.Address Then Exit Do 
        bCell.Offset(0, 1) = aCell.Offset(0, 1) 
      Else 
       Exit Do 
      End If 

     Loop 
Else 
' MsgBox "Not Found" 
    'Exit Sub 

    End If 
Next 
Exit Sub 
Err: 
MsgBox Err.Description 
End Sub 

Answer 2

Я думаю, что вы имели в виду использовать

If Not bCell Is Nothing Then 

, а не aCell, так как находка Set bCell = MapRange.Find ...