'Find'/'FindNext'重复地find相同的单元格或返回错误

我有一个医学术语表（F列）及其相关的数字代码（G列），我需要在列B中的列F中find医学术语，并将该术语的相关代码放在C列中。

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

代码运行后，我希望电子表格看起来像什么样子：

我的问题在于获取代码来查找列表中的下一个匹配项。 我在图像中的例子是医学术语： abnormal gait 。 您可以看到B列中有两个匹配项（第一个和最后一个单元格）。 我对这个代码进行了修改，从微软的例子和许多论坛已经推荐的资源的其他网站[3]中修改。 但是，无论我尝试修改第二个“find”命令的次数，我总是会遇到以下错误之一：

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

4. Find函数find第一个单元格，但是它永远不会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 

在这一点上，我尝试了所有我能想到的和我在网上find的一切，只是不知道下一步该怎么做。

Answer 1

这是一个有效的解决scheme，您的问题不使用.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 

Answer 2

我认为这是你正在写的东西：

 Sub Match2Cohort() Dim Phenotype As Range, FindMe As String, FoundinList As Range Dim LRp As Long, LastRow As Long, i As Long Dim FirstMatch As String Dim Terms As Range 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).Value2 'Find first occurrence. Set FoundinList = Phenotype.Cells.Find( _ What:=FindMe, _ After:=Phenotype.Cells(1), _ LookAt:=xlPart, _ SearchDirection:=xlNext) If Not FoundinList Is Nothing Then FirstMatch = FoundinList.Address Do If IsEmpty(FoundinList.Offset(0, 1)) Then 'No need for "=TRUE" as the statement returns TRUE/FALSE FoundinList.Offset(0, 1) = Cells(i, 7).Value Else FoundinList.Offset(0, 1) = FoundinList.Offset(0, 1).Value & "/" & Cells(i, 7).Value End If Set FoundinList = Phenotype.FindNext(FoundinList) Loop While Not FoundinList Is Nothing And FirstMatch <> FoundinList.Address End If Next i End Sub 

Answer 3

好吧，所以我认为最好的解决scheme是从FIND（）移开并使用strings.split和application.index以及application.match

这是逻辑：

循环1“循环通过列B中的单元格

将单元格文本以逗号分隔并放置在数组中

循环2“循环通过单独的Phenotype数组

使用application.match在F：G列中find术语和代码

将代码添加到列C中的单元格

这里是代码：

 Sub Text_Loop() Dim i As Integer Dim RngF as Range, RngB As Range Dim mycell As Range Dim phenoString() As String Dim phenoCode As Variant Set RngB = Sheet1.Range("b2:b" & Sheet1.Range("b2").End(xlDown).Row) Set RngF = Sheet1.Range("F2:F" & Sheet1.Range("F2").End(xlDown).Row) For Each mycell In RngB 'first loop phenoString = Split(mycell.Value, ",") For i = LBound(phenoString) To UBound(phenoString) 'second loop phenoCode = Application.Index(Sheet1.Range("F2:G" & Sheet1.Range("F2").End(xlDown).Row), _ Application.Match(phenoString(i), RngF, 0), 2) 'use variant so that we can check for an error If WorksheetFunction.IsError(phenoCode) = False Then 'checks to make sure phenocode was found If mycell.Offset(0, 1) <> "" Then 'formats multiple phenotype codes with / in correct place mycell.Offset(0, 1) = mycell.Offset(0, 1) & "/" & phenoCode Else mycell.Offset(0, 1) = phenoCode End If End If Next i 'end first loop Next mycell 'end second loop End Sub