Question

更新：

我已经完成了大量关于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

我正在尝试在Excel中编写一个宏来帮助对一组相对较大（~4000行）的数据进行排序。我已经挖掘了一堆VBA宏的例子，但我无法弄清楚如何将它们完全结合起来解决这个问题。

我有一张包含~4000行的工作表，其中只有一列包含一个字符串，该字符串描述了如何将代码跟踪到不同的数据集。示例单元格将包含“db_schema~＃~db_custom_object~＃~data_set_name”。我在本文档的另一页中给出了data_set_name的列表。接下来的任务是：找到4000行数据集中包含第二张表中任何data_set_name的行。

更简单地说（我认为），我需要创建一个使用搜索词列表搜索Excel工作表的宏。理想情况下，它会将匹配搜索条件的原始数据集中的每一行复制到第三张空白页中。

以下是我作为初学者离线的一些代码。我会坚持下去，但任何坚实的意见都会受到赞赏。

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

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

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

  'If value in column E = "Mail Box", copy entire row to Sheet2
  If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

     'Select row in Sheet1 to copy
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
     Selection.Copy

     'Paste row into Sheet2 in next row
     Sheets("Output").Select
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
     ActiveSheet.Paste

     'Move counter to next row
     LCopyToRow = LCopyToRow + 1

     'Go back to Sheet1 to continue searching
     Sheets("Data").Select

  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

Err_Execute:
MsgBox "An error occurred."

End Sub

Answer 1

（有问题 - 在第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

Answer 2

如果有人感兴趣，这是我最终使用的代码解决方案。这是一个遍历每个搜索项的简单循环，然后使用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

搜索列中包含另一列搜索词的字符串

2 个答案: