Excel / VBA迭代工作表中的每个单元格，比较值，将行复制到另一个工作表

In my Excel-File I want to implement a custom search. Therefore I created a worksheet called "Search" - On this Table I put a TextBox, a Button and a short Info-text. At the moment I go over every worksheet and copy the second row (Titles of my columns), then I compare the text of every cell with the searchword and if i get a match I will copy the row, where I found the match.

在我的excel文件中，我想实现一个自定义搜索。因此，我创建了一个名为“Search”的工作表——在这个表上，我放置了一个文本框、一个按钮和一个简短的信息文本。现在，我检查每个工作表并复制第二行(列的标题)，然后我将每个单元格的文本与searchword进行比较，如果我得到匹配，我将复制行，在那里找到匹配。

Private Sub SearchButton_Click()
Application.DisplayAlerts = False       

Dim searchword As String
searchword = Worksheets("Search").SearchTextBox.Text       

If Len(Trim(searchword)) > 0 Then       

    Worksheets("Search").Cells.Delete    

    Dim i As Long
    i = 5                       
    Dim found As Boolean

     For Each Worksheet In ActiveWorkbook.Worksheets       
        Worksheet.Range("A2").EntireRow.Copy Worksheets("Search").Cells(i, 1)    
        i = i + 1           
        found = False   
        For Each cell In Worksheet.UsedRange.Cells      
            If InStr(cell.Text, searchword) > 0 Then     
                cell.EntireRow.Copy Worksheets("Search").Cells(i, 1)    
                found = True     
                i = i + 1                       
            End If
        Next
        If found = True Then
            i = i + 4               
        Else
            Worksheets("Search").Rows(i - 1).Delete   
        End If
     Next

Else
    MsgBox "Empty TextBox!", vbOKOnly, "Error"      
End If

    Application.DisplayAlerts = True            
End Sub

But when a word is multiple times in one row this code will copy this row multiple times. How can I jump to the next row if I find a match?

但是当一个单词在一行中多次出现时，这段代码将多次复制这一行。如果找到匹配项，我怎么跳到下一排呢?

I'm glad for any help or idea

我很高兴有任何帮助或想法

2 个解决方案

#1

You could do it like this:

你可以这样做:

Private Sub SearchButton_Click()
    Application.DisplayAlerts = False

    Dim searchword As String
    searchword = Worksheets("Search").SearchTextBox.Text

    If Len(Trim(searchword)) > 0 Then

        Worksheets("Search").Cells.Delete

        Dim i As Long
        i = 5
        Dim found As Boolean

        For Each Worksheet In ActiveWorkbook.Worksheets
            Worksheet.Range("A2").EntireRow.Copy Worksheets("Search").Cells(i, 1)
            i = i + 1
            found = False
            For Each Row In Worksheet.UsedRange.Rows
                For Each cell In Row.Cells
                    If InStr(cell.Text, searchword) > 0 Then
                        cell.EntireRow.Copy Worksheets("Search").Cells(i, 1)
                        found = True
                        i = i + 1
                        Exit For
                    End If
                Next
            Next
            If found = True Then
                i = i + 4
            Else
                Worksheets("Search").Rows(i - 1).Delete
            End If
        Next

    Else
        MsgBox "Empty TextBox!", vbOKOnly, "Error"
    End If
End Sub

Note that this code also searches your Search worksheet, you may want to omit that sheet form the search.

注意，这段代码也会搜索您的搜索工作表，您可能想要从搜索中省略该工作表。

#2

The answer below will:

下面的回答:

1. Search all the sheets in the WorkBook which the code is placed, except the Sheet("Search").
2. 在工作簿中搜索代码所放置的所有页，除了“搜索”页。
3. In each of those Sheets it will run through every Row and look for the searchword. If it finds the word in that row it will copy the entire row into the Sheet("Search"). It will then move onto the next row of that Sheet.
4. 在每一页中，它将遍历每一行并查找搜索词。如果它在那一行中找到了单词，它将把整个行复制到表中(“Search”)。然后它会移动到那张纸的下一行。

See Code below:

请参见下面的代码:

Option Explicit

Private Sub SearchButton_Click()

    'Application.DisplayAlerts = False

    Dim CurrentSheet As Worksheet
    Dim LastRow As Long
    Dim CurrentRow As Long
    Dim LastColumn As Long
    Dim searchword As String
    Dim TextFoundRng As Range

    searchword = Worksheets("Search").SearchTextBox.Text

    If Len(Trim(searchword)) > 0 Then

        Worksheets("Search").Cells.Delete

        Dim i As Long
        i = 5
        Dim found As Boolean

        'Using this WorkBook instead of Active, incase another workbook is activated
        For Each CurrentSheet In ThisWorkbook.Worksheets

            If CurrentSheet.Name = "Search" Then

            Else

                With CurrentSheet
                    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
                End With


                'i = i + 1
                'found = False

                For CurrentRow = 2 To LastRow

                    Set TextFoundRng = CurrentSheet.Range(CurrentSheet.Cells(CurrentRow, 2), _
                                                          CurrentSheet.Cells(CurrentRow, LastColumn)).Find(What:=searchword)
                    'When TextFoundRng <> nothing, it means found something'
                    If Not TextFoundRng Is Nothing Then

                        CurrentSheet.Rows(CurrentRow).EntireRow.Copy Destination:=ThisWorkbook.Sheets("Search").Range("A" & Rows.Count).End(xlUp).Offset(1)

                    End If

                Next CurrentRow

                'For Each cell In CurrentSheet.UsedRange.Cells
                '
                '    If InStr(cell.Text, searchword) > 0 Then
                '        cell.EntireRow.Copy CurrentSheet("Search").Cells(i, 1)
                '        found = True
                '        i = i + 1
                '    End If
                '
                'Next
                'If found = True Then
                '    i = i + 4
                'Else
                '    Worksheets("Search").Rows(i - 1).Delete
                'End If

            End If
        Next CurrentSheet

    Else
        MsgBox "Empty TextBox!", vbOKOnly, "Error"
    End If

    'Application.DisplayAlerts = True
End Sub

I have kept your Found and i code in case you need it for something else, but this code does not need to use it to copy every row which has the searchword from every sheet.

我保留了你的找到，我编码以防你需要它做其他事情，但是这个代码不需要用它来拷贝每一行，每一行都有搜索词。