Vba 搜索列以查找包含在另一列搜索词中的字符串

更新：

我对VBA以及如何使用它做了大量的学习。我已经想出了下面的代码，但仍然遇到麻烦。我从未在while循环中显示调试消息。这可能是由什么问题引起的

新代码：

Sub SearchForValues()
'VARIABLE DECLARATIONS
Dim count As Integer, SearchRow As Integer, ItemRow As Integer, CopyRow As Integer, position As Integer

On Error GoTo Err_Execute

'VARIABLE INITILIZATIONS
SearchRow = 1 'for each item in the search set
ItemRow = 1 'for each item in the data set
CopyRow = 1 'for each item that is copied over
count = 0
position = 0

'MsgBox "The main code is about to start"

'MAIN CODE LOOP
While Worksheets(3).Cells(SearchRow, 1) <> "" 'for each search term
    'MsgBox "We are inside the outside while loop."

    While Worksheets(1).Cells(ItemRow, 1) <> "" 'for each data item
        'MsgBox "We are inside the inside while loop."

        'does the data item contain the search term?
        position = InStr(Worksheets(1).Cells(ItemRow, 1), Worksheets(3).Cells(SearchRow, 1))
        If position > 0 Then
            Worksheets(3).Cells(CopyRow, 1).Value = Worksheets(1).Cells(SearchRow, 1).Value 'move the row to the open sheet
            CopyRow = CopyRow + 1
            count = count + 1
        End If

        'try next data set item
        ItemRow = ItemRow + 1
    Wend
    'try next search set item
    SearchRow = SearchRow + 1
Wend

MsgBox "Found " & count & " instances and moved them. Done." 'print out count and final message

Exit Sub

Err_Execute:
MsgBox "An error occured."

End Sub

（有问题——在第4行开始搜索？）

我认为这种方法将有助于您：

Sub SearchForString()
  Dim LSearchRow$, LCopyToRow&, s1$
  On Error GoTo Err_Execute
  'Start search in row 4
  LSearchRow = 1
  'Start copying data to row 2 in Sheet2 (row counter variable)
  LCopyToRow = 1
  s1 = CStr(LSearchRow)
  While Cells(LSearchRow, 1) <> ""
    'If value in column E = "Mail Box", copy entire row to Sheet2
    If Cells(LSearchRow, 5) = "Mail Box" Then
     ' copy
      Sheets("Sheet1").Rows(LSearchRow).Copy Sheets("Output").Rows(LCopyToRow)
     'Move counter to next row
      LCopyToRow = LCopyToRow + 1
    End If
  LSearchRow = LSearchRow + 1
  Wend
  'Position on cell A3
  Application.CutCopyMode = False
  Range("A3").Select
  MsgBox "All matching data has been copied."
Exit Sub

子SearchForString（）
Dim LSearchRow$，LCopyToRow和s1$
错误时转到错误执行
'在第4行开始搜索
LSearchRow=1
'开始将数据复制到Sheet2的第2行（行计数器变量）
LCopyToRow=1
s1=CStr（LSearchRow）
而单元格（LSEARCROW，1）”
'如果E=“邮箱”列中有值，则将整行复制到Sheet2
如果单元格（LSearchRow，5）=“邮箱”，则
”“是的
图纸（“图纸1”）.行（LSearchRow）。复制图纸（“输出”）.行（LCopyToRow）
'将计数器移到下一行
LCopyToRow=LCopyToRow+1
如果结束
LSearchRow=LSearchRow+1
温德
'单元格A3上的位置
Application.CutCopyMode=False
范围（“A3”）。选择
MsgBox“已复制所有匹配数据。”
出口接头

如果有人感兴趣，下面是我最终使用的代码解决方案。它是一个简单的循环，遍历每个搜索项，然后使用InStr搜索数据项，InStr返回子字符串在字符串中的位置。如果pos>0，则知道子字符串实际上包含在字符串中

我让它在工作簿的第三页打印输出

Private Sub Search_Click()
'VARIABLE DECLARATIONS
Dim count As Integer, SearchRow As Integer, ItemRow As Integer, CopyRow As Integer, position As Integer
Dim SearchCount As Integer, ItemCount As Long
Dim str() As String

On Error GoTo Err_Execute

'VARIABLE INITILIZATIONS
SearchRow = 1 'for each item in the search set
ItemRow = 1 'for each item in the data set
CopyRow = 1 'for each item that is copied over
SearchCount = 0 'number of search terms
ItemCount = 0 'number of items iterated through
count = 0
position = 0

'MAIN CODE LOOP
Do While Worksheets(2).Cells(SearchRow, 1).Value <> "" 'for each search term
    SearchCount = SearchCount + 1
    ItemRow = 1

    Do While Worksheets(1).Cells(ItemRow, 1).Value <> "" 'for each data item
        ItemCount = ItemCount + 1

        position = InStr(Worksheets(1).Cells(ItemRow, 1), Worksheets(2).Cells(SearchRow, 1)) 'does the data item contain the search term?
        If position > 0 Then
            str = Split(Worksheets(1).Cells(ItemRow, 1).Value, "use_your_own_delimiter") 'split the data item into group and object names
            Worksheets(3).Cells(CopyRow, 1).Value = Worksheets(2).Cells(SearchRow, 1).Value
            Worksheets(3).Cells(CopyRow, 2).Value = str(0)
            Worksheets(3).Cells(CopyRow, 3).Value = str(1)
            Worksheets(3).Cells(CopyRow, 4).Value = Worksheets(1).Cells(ItemRow, 1).Value 'move the row to the open sheet
            CopyRow = CopyRow + 1
            count = count + 1
        End If

        ItemRow = ItemRow + 1 'try next data set item
    Loop

    SearchRow = SearchRow + 1 'try next search set item
Loop

MsgBox "Searched " & SearchCount & " terms among " & ItemCount & " data entries." & vbNewLine & "Found " & count & " instances and moved them. Done." 'print out count and final message

Exit Sub

Err_Execute:
MsgBox "An error occured."

End Sub

Private Sub Search\u Click（）
'变量声明
Dim count为整数、SearchRow为整数、ItemRow为整数、CopyRow为整数、position为整数
Dim SearchCount为整数，ItemCount为长
Dim str（）作为字符串
错误时转到错误执行
'变量初始化
搜索集中每个项目的SearchRow=1
数据集中每个项目的ItemRow=1
CopyRow=1'用于复制的每个项目
SearchCount=0'搜索字数
ItemCount=0'迭代通过的项目数
计数=0
位置=0
'主代码循环
Do While工作表（2）。单元格（SearchRow，1）。为每个搜索词设置“”值
SearchCount=SearchCount+1
ItemRow=1
Do While工作表（1）。单元格（ItemRow，1）。每个数据项的值为“”
ItemCount=ItemCount+1
position=InStr（工作表（1）.单元格（ItemRow，1），工作表（2）.单元格（SearchRow，1））'数据项是否包含搜索项？
如果位置>0，则
str=Split（工作表（1）.单元格（ItemRow，1）.值，“使用您自己的分隔符”）将数据项拆分为组名和对象名
工作表（3）.单元格（CopyRow，1）.值=工作表（2）.单元格（SearchRow，1）.值
工作表（3）.单元格（CopyRow，2）.值=str（0）
工作表（3）.单元格（CopyRow，3）.值=str（1）
工作表（3）.单元格（CopyRow，4）.值=工作表（1）.单元格（ItemRow，1）.值'将行移动到打开的工作表
CopyRow=CopyRow+1
计数=计数+1
如果结束
ItemRow=ItemRow+1'尝试下一个数据集项
环
SearchRow=SearchRow+1'尝试下一个搜索集项目
环
MsgBox“Searched”&SearchCount&“ItemCount&“data entries.”&vbNewLine&“Found”&count&“instances”并将其移动。完成。“”打印出计数和最终消息
出口接头
执行错误：
MsgBox“发生错误。”
端接头

感谢您的回复。这段代码完全是从另一篇文章中摘取的，所以我并不声称自己理解它。如果你看一下我上面的代码，基本上是这样的。

Private Sub Search_Click()
'VARIABLE DECLARATIONS
Dim count As Integer, SearchRow As Integer, ItemRow As Integer, CopyRow As Integer, position As Integer
Dim SearchCount As Integer, ItemCount As Long
Dim str() As String

On Error GoTo Err_Execute

'VARIABLE INITILIZATIONS
SearchRow = 1 'for each item in the search set
ItemRow = 1 'for each item in the data set
CopyRow = 1 'for each item that is copied over
SearchCount = 0 'number of search terms
ItemCount = 0 'number of items iterated through
count = 0
position = 0

'MAIN CODE LOOP
Do While Worksheets(2).Cells(SearchRow, 1).Value <> "" 'for each search term
    SearchCount = SearchCount + 1
    ItemRow = 1

    Do While Worksheets(1).Cells(ItemRow, 1).Value <> "" 'for each data item
        ItemCount = ItemCount + 1

        position = InStr(Worksheets(1).Cells(ItemRow, 1), Worksheets(2).Cells(SearchRow, 1)) 'does the data item contain the search term?
        If position > 0 Then
            str = Split(Worksheets(1).Cells(ItemRow, 1).Value, "use_your_own_delimiter") 'split the data item into group and object names
            Worksheets(3).Cells(CopyRow, 1).Value = Worksheets(2).Cells(SearchRow, 1).Value
            Worksheets(3).Cells(CopyRow, 2).Value = str(0)
            Worksheets(3).Cells(CopyRow, 3).Value = str(1)
            Worksheets(3).Cells(CopyRow, 4).Value = Worksheets(1).Cells(ItemRow, 1).Value 'move the row to the open sheet
            CopyRow = CopyRow + 1
            count = count + 1
        End If

        ItemRow = ItemRow + 1 'try next data set item
    Loop

    SearchRow = SearchRow + 1 'try next search set item
Loop

MsgBox "Searched " & SearchCount & " terms among " & ItemCount & " data entries." & vbNewLine & "Found " & count & " instances and moved them. Done." 'print out count and final message

Exit Sub

Err_Execute:
MsgBox "An error occured."

End Sub