excel - 使用 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