Question

我想修改下面的代码

我希望findwhat从范围中选择文本（“a1：20”） - 其中包含我想要查找的文本列表

如果它在B中的描述中找到文本，我希望它返回它找到的文本，例如在其描述旁边的JO IN范围c

谢谢

Option Explicit

Sub x()
    Dim FindWhat, rngCell As Range, i As Integer

    FindWhat = Array("Jo", "oa", "of", "koo")
    For i = 0 To 3
        For Each rngCell In Range("B2", Range("B" & Rows.Count).End(xlUp))
            If InStr(rngCell, FindWhat(i)) <> 0 Then
                rngCell.Offset(0, 1) = rngCell
                rngCell.Offset(, 1).Resize(, 2).Copy
            End If
        Next rngCell
    Next i

End Sub

Answer 1

试试这个：

Option Explicit

Sub x()
    Dim findRng As Range, _
        targetRng As Range, _
        findCell As Range, _
        found As Range
    Dim i As Integer
    Dim firstFound As String, _
        columnName As String

    columnName = "B"
    Set findRng = Range("A1:A20")
    For Each findCell In findRng
        Set targetRng = Range(columnName & "2", Range(columnName & Rows.Count).End(xlUp))
        With targetRng
            Set found = .Find(findCell.Value, LookIn:=xlValues, lookat:=xlPart)
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    found.Offset(0, 1).Value = found.Offset(0, 1).Value & findCell.Value & ", "
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    Next findCell

End Sub

请注意，除非您正在做的事情比这更复杂，否则您可以使用单元格公式来实现此结果。阅读Index，Match和VLookup函数的帮助，了解如何实现这一目标。

用于搜索文本的VBA代码

1 个答案: