在单元格中查找字符串集并仅通过 VBA 将找到的字符串复制到下一个单元格

Question

我在工作表中的单元格内有一组可变的字符串，例如“horse”“apple”“apple/2”“cat”等。

我只需要复制找到的字符串并将其粘贴到下一个单元格。

例如：

B 列中的单元格是“今天马很开心”。所以我只需要复制“马”这个词并将其粘贴到下一个单元格。 B 列中的另一个单元格包含例如“猫在睡觉”。所以我只需要复制单词“cat”并将其粘贴到下一个单元格。

我在所有 B 列中有一组可能的字符串。

Sub TEST()

Dim c As Range

For Each c In Range("B1:B1500")
    If InStr(1, c.Text, "horse") Then
        c.Copy Destination:=c.Offset(ColumnOffset:=1)
    End If
Next c

End Sub

我复制了包含“马”的整个单元格，但我只需要一个“马”字。

另外，我必须复制或三倍此代码仅更改字符串。这不是一种快速的方法，因为它会读取每个单元格并尝试找到一个字符串，然后与下一个字符串相同。

我想粘贴我想要的所有字符串：（猫、马、苹果等）然后如果在 B 列的单元格中找到其中一个，则仅将找到的字符串粘贴到下一个单元格。

有人可以帮助我吗？

Answer 1

根据您的描述，我认为这可能对您有用。

Sub TEST()

Dim aFindWords
Dim iLoop As Integer
Dim c As Range

aFindWords = Split("horse,cat,apple,apple/2", ",")

For iLoop = LBound(aFindWords) To UBound(aFindWords)
    For Each c In Range("B1:B1500")
        If InStr(1, c.Text, aFindWords(iLoop)) Then
            c.Offset(0, 1) = aFindWords(iLoop)
        End If
    Next c
Next iLoop
End Sub