Question

我是一名VBA初学者试图从有用的贡献者那里重新编写一些代码，我遇到了一些麻烦，我希望你能帮助我。

我在一个表格（DATA2）中有一系列评论，在另一个表格中有关键字（KEYWORDS）。我的目标是搜索评论，并在找到其中一个关键字时为其分配一个类别。

下面的代码按照我想要的某些值(Data = Eric Keyword = Eric)运行。但是，在其他值上会抛出“未设置对象变量”错误，我假设因为未找到该值(Data=Ericlikespie Keyword = Eric OR Data=Emi No Keyword)。

任何指针都会有所帮助。我查看了以前的答案，但大多数似乎与范围设置问题有关。我意识到可以使用条件格式或大索引+搜索公式手动完成所有这些，但我正在寻找更好的东西。

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

我认为您打算使用

If Not bCell Is Nothing Then

而不是aCell，因为查找是Set bCell = MapRange.Find ...

Answer 2

我用下面的代码解决了这个问题。查找表和目标表在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

VBA Range.find错误（非xlPart查找＆amp;对象变量未设置错误）

2 个答案: