vba - '.Find'/'.FindNext' 重复查找相同单元格或返回错误

Question

我有一个医学术语列表(F 列)及其关联的数字代码(G 列)，我需要在 B 列的列表中的 F 列中找到医学术语，并将该术语的关联代码放入 C 列.

我的电子表格的简化版本的图像:

我希望电子表格在代码运行后看起来像这样:

我的问题是获取代码来查找列表中的下一个匹配项。我在图像中的示例是医学术语:异常步态。您可以看到 B 列(第一个和最后一个单元格)中有两个匹配项。我的代码是根据 Microsoft 中的示例修改的。以及[许多论坛一直推荐作为资源的另一个网站][3]。但是，无论我尝试修改第二个“查找”命令多少次，我总是会遇到以下错误之一:

1. 无法获取 Range 类的 FindNext 属性
2. 类型不匹配错误
3. Find 函数重复查找同一单元格

4. Find 函数找到第一个单元格，但它永远找不到下一个单元格并通过 End If 退出。

   Sub Match2Cohort()
   Dim Phenotype, FindMe, FoundinList As Range
   Dim LRp, LastRow, i As Long
   Dim FirstMatch As String
   
   LRp = Cells(Rows.Count, 2).End(xlUp).Row
   LastRow = Cells(Rows.Count, 6).End(xlUp).Row
   Set Phenotype = Range("B1:b" & LRp)
   Set Terms = Range("F1:f" & LastRow)
   
   For i = 18 To LastRow
       FindMe = Cells(i, 6).Value
       Set FoundinList = Phenotype.Cells.Find(What:=FindMe, LookAt:=xlWhole)
       On Error Resume Next
   
       If Not FoundinList Is Nothing Then
           FirstMatch = FoundinList.Row
           Do
   'This loop allows me to combine multiple medical codes into the same cell.                    
               If IsEmpty(FoundinList.Offset(0, 1)) = True Then
                       FoundinList.Offset(0, 1) = Cells(i, 7).Value
               Else: FoundinList.Offset(0, 1) = FoundinList.Offset(0, 1).Value & "/" & Cells(i, 7).Value
               FoundinList.Offset(0, 1).Select
               End If
   
   'This is the code that is not working and all of the variations I've tried:
       With Phenotype
           Set FoundinList = .FindNext(FindMe)
           Set FoundinList = .FindNext(FindMe, After:=ActiveCell)
           Set FoundinList = .FindNext(After:=ActiveCell)
       End With
   
           Set FoundinList = Phenotype.FindNext(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
           Set FoundinList = Phenotype.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
           Set FoundinList = Phenotype.FindNext(After:=FoundinList)
           Set FoundinList = Phenotype.FindNext(What:=FindMe, After:=FoundinList, LookAt:=xlWhole)
           Set FoundinList = Phenotype.Find(What:=FindMe, After:=FoundinList, LookAt:=xlWhole)
   
           Loop While FirstMatch <> FoundinList.Row
       End If
   Next i
   
   End Sub
   

此时，我已经尝试了我能想到的一切以及我在网上找到的所有内容，但只是不知道下一步该尝试什么。

Answer 1

这是解决您的问题的有效解决方案，不使用 .Find 或 .FindNext 方法。

Sub Match2Cohort()
    Dim i&, k&, TTmp$, PTmp$, p, t
    t = [f1].CurrentRegion.Resize(, 2)
    With ActiveSheet
        p = [b1].Resize(.Cells(.Rows.Count, "b").End(xlUp).Row, 2)
    End With
    For i = 1 To UBound(t)
        TTmp = LCase$(Replace(t(i, 1), " ", ""))
        For k = 1 To UBound(p)
            PTmp = "," & LCase$(Replace(p(k, 1), " ", "")) & ","
            If InStr(PTmp, "," & TTmp & ",") Then
                PTmp = p(k, 2) & "/" & t(i, 2)
                If Left$(PTmp, 1) = "/" Then PTmp = Mid$(PTmp, 2)
                p(k, 2) = PTmp
            End If
        Next
    Next
    [b1].Resize(UBound(p), UBound(p, 2)) = p
End Sub