使用VBA获取包含子字符串的单元格列表

Question

我想知道如何使用VBA在Excel文件中生成包含给定子字符串的单元格列表。无论大小写如何，这都应该能够找到单元格。

一个例子是：

考虑到用户定义的输入（苹果和浆果），它将返回第二张图片。

如何在VBA中执行此操作？

Answer 1

您说生成列表...所以我假设您不会覆盖您的旧数据。

此代码检查工作表“ Sheet1”中的两个值。然后将您定义的两个值与数据中的单元格值进行比较（假定您的数据在A列中，从第1行开始向下）。如果单元格中存在定义的值中的任意一个（苹果或浆果，不考虑大小写字母），则将其视为匹配项。如果找到匹配项，它将把值复制到B列的第一行。

VBA代码：

Sub SearchAndExtract()

Dim lrow As Long
Dim lrowNewList As Long
Dim i As Long
Dim lookupValue As String
Dim lookupValue2 As String
Dim currentValue As String
Dim MySheet As Worksheet
Set MySheet = ActiveWorkbook.Worksheets("Sheet1")

lookupValue = "*apple*" 'First name you want to search for. Use * for wildcard
lookupValue2 = "*berry*" 'Second name you want to search for. Use * for wildcard

lrow = MySheet.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row in your data column
lrowNewList = MySheet.Cells(Rows.Count, "B").End(xlUp).Row 'Find last row in the column you want to paste to

For i = 1 To lrow 'From Row 1 to last row in the column where you want to check your data
    currentValue = MySheet.Cells(i, "A").Value 'Define the string value you have in your current cell
    If LCase$(currentValue) Like LCase$(lookupValue) Or _
       LCase$(currentValue) Like LCase$(lookupValue2) Then 'LCase for case sensitivity, it check the current cell against the two lookup values. If either of those are find, then
            MySheet.Cells(lrowNewList, "B") = MySheet.Cells(i, "A") 'Copy from current cell in column a to last blank cell in column B
            lrowNewList = lrowNewList + 1
    End If
Next i
End Sub