Fatal编程技术网
  • vba/
  • Vba '；。查找'/'；。FindNext'；重复查找同一单元格或返回错误

Vba '；。查找'/'；。FindNext'；重复查找同一单元格或返回错误

vba excel

Vba '；。查找'/'；。FindNext'；重复查找同一单元格或返回错误,vba,excel,Vba,Excel,我有一个医疗术语列表（F列）及其相关数字代码（G列），我需要在B列的列表中的F列中找到医疗术语，并将该术语的相关代码放入C列 我的电子表格简化版的图像： 运行代码后，我希望电子表格是什么样子： 我这里的问题是让代码在列表中查找下一个匹配项。我在图像中的例子是医学术语：异常步态。您可以看到B列中有两个匹配项（第一个单元格和最后一个单元格）。我为此编写的代码是根据和[许多论坛一直推荐作为资源的其他网站][3]中的示例修改的。但是，无论我尝试修改第二个“find”命令多少次，最终都会出现以下错误之

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

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

运行代码后，我希望电子表格是什么样子：

我这里的问题是让代码在列表中查找下一个匹配项。我在图像中的例子是医学术语：
异常步态
。您可以看到B列中有两个匹配项（第一个单元格和最后一个单元格）。我为此编写的代码是根据和[许多论坛一直推荐作为资源的其他网站][3]中的示例修改的。但是，无论我尝试修改第二个“find”命令多少次，最终都会出现以下错误之一：

  • 无法获取Range类的FindNext属性
  • 类型不匹配错误
  • 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

    Sub Match2Cohort（）
Dim表型、FindMe、FOUNINLIST As范围
昏暗的LRp，最后一排，我一样长
将第一个匹配设置为字符串
LRp=单元格（Rows.Count，2）.End（xlUp）.Row
LastRow=单元格（Rows.Count，6）.End（xlUp）.Row
设定表型=范围（“B1:b”和LRp）
设置术语=范围（“F1:f”和最后一行）
从i=18到最后一行
FindMe=单元（i，6）.值
Set FoundinList=epotype.Cells.Find（What:=FindMe，LookAt:=xlother）
出错时继续下一步
如果不是FoundinList，则为Nothing
FirstMatch=FoundinList.Row
做
“这个循环允许我将多个医疗代码组合到同一个单元格中。
如果IsEmpty（FoundinList.Offset（0，1））=True，则
偏移量（0，1）=单元格（i，7）.值
Else:FoundinList.Offset（0，1）=FoundinList.Offset（0，1）.Value&“/”单元格（i，7）.Value
FoundinList.Offset（0，1）。选择
如果结束
'这是不起作用的代码以及我尝试过的所有变体：
有表型
Set FoundinList=.FindNext（FindMe）
Set FoundinList=.FindNext（FindMe，After:=ActiveCell）
Set FoundinList=.FindNext（之后：=ActiveCell）
以
Set-FoundinList=Phenophy.FindNext（What:=FindMe，After:=ActiveCell，LookAt:=xlWhole）
Set FoundinList=epotype.Find（What:=FindMe，After:=ActiveCell，LookAt:=xlother）
Set-FoundinList=Phenophy.FindNext（之后：=FoundinList）
Set FoundinList=epotype.FindNext（What:=FindMe，After:=FoundinList，LookAt:=xlother）
Set FoundinList=epotype.Find（What:=FindMe，After:=FoundinList，LookAt:=xlother）
在FirstMatch FoundinList.Row时循环
如果结束
接下来我
端接头
    • 在这一点上，我已经尝试了我能想到的一切和我在网上找到的一切，只是不知道下一步要尝试什么。

    我想这就是你想要写的：

    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

    Sub Match2Cohort（）
Dim表型作为范围，FindMe作为字符串，FoundinList作为范围
昏暗的LRp一样长，最后一排一样长，我一样长
将第一个匹配设置为字符串
作为范围的模糊术语
LRp=单元格（Rows.Count，2）.End（xlUp）.Row
LastRow=单元格（Rows.Count，6）.End（xlUp）.Row
设定表型=范围（“B1:B”和LRp）
设置术语=范围（“F1:F”和最后一行）
从i=18到最后一行
FindMe=单元（i，6）。值2
“找到第一个事件。
Set FoundinList=表型.细胞.查找（_
什么：=FindMe_
之后：=表型细胞（1）_
看：=xlPart_
搜索方向：=xlNext）
如果不是FoundinList，则为Nothing
FirstMatch=FoundinList.Address
做
如果IsEmpty（FoundinList.Offset（0，1）），则“不需要”=TRUE”，因为语句返回TRUE/FALSE
偏移量（0，1）=单元格（i，7）.值
其他的
FoundinList.Offset（0，1）=FoundinList.Offset（0，1）.Value&“/”单元格（i，7）.Value
如果结束
Set-FoundinList=表型。FindNext（FoundinList）
非FoundinList时的循环为Nothing，并且FirstMatch FoundinList.Address
如果结束
接下来我
端接头
    好的，所以我认为最好的解决方案是远离FIND（），使用strings.split、application.index和application.match

    逻辑是这样的：

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

    在逗号处拆分单元格文本并放入数组中

    环2'环通过个体表型阵列

    使用application.match在F:G列中查找术语和代码

    将代码添加到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

    子文本_循环（）
作为整数的Dim i
变暗RngF为范围，RngB为范围
暗淡的迈塞尔山脉
将字符串（）设置为字符串
作为变体的Dim表型编码
设置RngB=Sheet1.范围（“b2:b”和Sheet1.范围（“b2”）。结束（xlDown）。行）
设置RngF=Sheet1.范围（“F2:F”和Sheet1.范围（“F2”）。结束（xlDown）。行）
对于RngB第一个循环中的每个迈塞尔
phenoString=Split（mycell.Value，“，”）
对于i=LBound（phenoString）到UBound（phenoString）的第二个循环
phenoCode=应用程序索引（Sheet1.范围（“F2:G”）和Sheet1.范围（“F2”）.End（xlDown）.Row）_
Application.Match（phenoString（i），RngF，0），2）使用variant以便检查错误
如果工作表function.IsError（phenoCode）=False，则“检查”以确保找到phenoCode
如果mycell.Offset（0，1）“，则”使用/在正确的位置格式化多个表型代码
mycell.Offset（0,1）=mycell.Offset（0,1）&“/”和phenoCode
其他的
迈塞尔偏移量（0，1）=符号代码
如果结束
如果结束
接下来我结束第一个循环
下一个迈塞尔结束第二个循环
端接头
    以下是解决您的问题的有效方法 
    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