Excel VBA 在字符串中搜索字符串数组答案

【问题标题】：Excel VBA to Search for an Array of Strings within a StringExcel VBA 在字符串中搜索字符串数组
【发布时间】：2016-06-15 04:33:39
【问题描述】：

我正在尝试创建一个循环变量，该变量在字符串中查找字符串数组，如果找到匹配项，则将它们分配给组，但是，我不需要它是完全匹配的，只要源字符串是 LIKE 搜索字符串。下面贴出示例代码：

Sub add_Categories()

Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False



Set rRange = Range("B1", Range("B65536").End(xlUp))

Application.DisplayAlerts = False

With wSheetStart
    For Each rCell In rRange


    If rCell Like "*Apple*" Then rCell.Offset(0, 2) = "Grocery"
    If rCell Like "*Orange*" Then rCell.Offset(0, 2) = "Grocery
    If rCell Like "*Mop*" Then rCell.Offset(0, 2) = "Kitchen"
    If rCell Like "*Broom*" Then rCell.Offset(0, 2) = "Kitchen"
    'If rCell Like "*Shirt*" Then rCell.Offset(0, 2) = "Clothing"
    'If rCell Like "*Pants*" Then rCell.Offset(0, 2) = "Clothing"


    Next rCell
End With

With wSheetStart
    '.AutoFilterMode = False
    .Activate
End With

On Error GoTo 0

Application.DisplayAlerts = True

End Sub

上面的示例每个类别只有两个字符串，但实际上我有数百个字符串，将它们作为数组输入比为每个语句设置一行要容易得多。非常感谢任何帮助。

【问题讨论】：

不确定您是否知道，但您的代码在 Grocery 的第二个实例末尾缺少双引号。
如果您有这么多对产品和类别：将它们放在隐藏的工作表中而不是将它们硬编码在数组中不是更容易吗？

标签： arrays string excel vba

【解决方案1】：

这是使用数组并循环遍历它的一种方式：

Sub add_Categories()
Dim rRange As Range, rCell As Range, wSheet As Worksheet, wSheetStart As Worksheet, X As Long, FindArr As Variant, FoundArr As Variant
FindArr = Array("Apple", "Orange", "Mop", "Broom", "Shirt", "Pants")
FoundArr = Array("Grocery", "Grocery", "Kitchen", "Kitchen", "Clothing", "Clothing")
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("B1", Range("B" & Rows.Count).End(xlUp))
Application.DisplayAlerts = False
With wSheetStart
    For Each rCell In rRange
        For X = LBound(FindArr) To UBound(FindArr)
            If rCell Like "*" & FindArr(X) & "*" Then rCell.Offset(0, 2) = FoundArr(X)
        Next
    Next
End With
With wSheetStart
    '.AutoFilterMode = False
    .Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
End Sub

将您需要的内容添加到 FindArr 并将相应的输出添加到 FoundArr

还要注意这里的变化：Set rRange = Range("B1", Range("B" & Rows.Count).End(xlUp)) 使用 rows.count 而不是硬编码行号。

【讨论】：