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

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

例如：

给定用户定义的输入（apple和berry），它将返回第二张图片

---

如何在VBA中执行此操作？

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

此代码检查工作表“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

---

到目前为止你试过什么？即使它不起作用，也值得发布，因为这样可以避免我们翻越已经覆盖的土地。你在筛选列表或将结果转换为图像时遇到问题吗？@Comintern我在编写筛选列表的代码时遇到问题。。不将结果转换为图像。请阅读：如果要在同一列中用旧表替换新表，我将用旧数据删除A列。将其添加到vba代码的

下一个i

：

列（1）之后。EntireColumn.Delete