如果单词多次退出，则从范围中查找单词列表

Question

我有一个Sheet1 中的单词列表，我需要从Sheets("Sheet2").Range("A1:A7500") 到Range 的末尾一一匹配。每当单词匹配时，我需要在Sheet1 中对其进行处理。该词在Sheets("Sheet2").Range("A1:A7500") 中出现多次。

以下代码仅查找单词一次。我不明白哪里出了问题。

Sub XMAX()
Dim lrow As Long
Dim cel As Range
Dim oRng As Range: Set oRng = Sheets("Sheet2").Range("A1:A7500")
Dim oFoundRng As Range, oLastRng As Range


    lrow = Sheets("sheet1").Cells(Sheets("Sheet1").Rows.Count, "f").End(xlUp).Row
    '''''''''''''''Sheet1'''''''''''''''
    For Each cel In Range("f4:f" & lrow)

        If IsEmpty(cel.Value) = False Then

            Set oFoundRng = oRng.find(cel.Value)

            Do While Not oFoundRng Is Nothing

                    If UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
                        Range("X" & cel.Row).Value = "X"
                    ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "YO" Then
                        Range("V" & cel.Row).Value = "X"
                    ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "JAN" Then
                        Range("U" & cel.Row).Value = "X"
                    Else
                        MsgBox oFoundRng.Value
                    End If


                Set oLastRng = oFoundRng                    
                Set oFoundRng = oRng.FindNext(cel.Value)   'Getting Error(1004) here "unable to get findnext property of the range class" 
                If oLastRng >= oFoundRng Then               
                    Exit Do                                 
                End If
            Loop

        Else
        End If

    Next

Answer 1

改变这一行

Set oFoundRng = oRng.FindNext(oFoundRng)

到

Set oFoundRng = oRng.FindNext

您搜索的不是单词，而是您之前找到的范围。实际上，您根本不需要将值传递给 .FindNext。

你也必须改变这一行

If oLastRng >= oFoundRng Then

到

If oLastRng.Row >= oFoundRng.Row Then

因为第一行比较了值（这不是您想要做的，因为它总是评估为True）。您实际上想要比较行号。

另一方面，以下代码 sn-p 不起作用：

If UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
    Range("X" & cel.Row).Value = "X"
ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
    Range("W" & cel.Row).Value = "X"

此ElseIf 永远不会被触发，因为条件与初始If 条件相同。

你也不需要这两个语句：

Set oFoundRng = Nothing
Exit Do

他们都完成了同样的事情（打破循环），Exit Do 做得更有效。

Answer 2

你可能会在这之后（在 cmets 中解释）：

Sub XMAX()
    Dim cel As Range
    Dim oRng As Range: Set oRng = Sheets("Sheet2").Range("A1:A7500")
    Dim oFoundRng As Range
    Dim firstAddress As String

    With Sheets("sheet1") ' reference "Sheet1" sheet
        With .Range("f4", .Cells(.Rows.Count, "f").End(xlUp)) ' reference referenced sheet column "F" range from row 4 down to last not empty one
            If WorksheetFunction.CountA(.Cells) > 0 Then ' if there's at least one not empty cell
                For Each cel In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty cells

                    Set oFoundRng = oRng.Find(what:=cel.Value, LookIn:=xlValues, lookat:=xlWhole) ' always specify at least 'LookIn' and 'LookAt' parameters, or they will be set as per last 'Find()' usage (even from Excel UI!)
                    If Not oFoundRng Is Nothing Then ' if a match found
                        firstAddress = oFoundRng.Address ' store first matched cell address
                        Do
                            Select Case UCase(oFoundRng.Offset(0, 1).Value2)
                                Case "ISAAC"
                                    .Range("X" & cel.Row).Value = "X"
                                Case "YO"
                                    .Range("V" & cel.Row).Value = "X"
                                Case "JAN"
                                    .Range("U" & cel.Row).Value = "X"
                                Case Else
                                    MsgBox oFoundRng.Value
                            End Select

                            Set oFoundRng = oRng.FindNext(oFoundRng) ' search for next occurrence
                        Loop While oFoundRng.Address <> firstAddress ' exit do when hitting fisr found cell again
                    End If

                Next
            End If
        End With
    End With
End Sub