Question

在我的Excel文件中，我想实现自定义搜索。因此，我创建了一个名为“搜索”的工作表 - 在此表中，我放置了一个TextBox，一个Button和一个简短的Info-text。目前我遍历每个工作表并复制第二行（我的列的标题），然后我将每个单元格的文本与搜索词进行比较，如果我得到一个匹配，我将复制该行，我找到了匹配。< / p>

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

但是当一个单词在一行中多次出现时，此代码将多次复制此行。如果找到匹配，我怎样才能跳到下一行？

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

Answer 1

你可以这样做：

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

请注意，此代码还会搜索您的搜索工作表，您可能希望从搜索中省略该表格。

Answer 2

以下答案将：

搜索代码所在的WorkBook中的所有工作表，Sheet("Search")除外。
在每个Sheets中，它会遍历每个Row并查找searchword。如果它在该行中找到该单词，则会将整行复制到Sheet("Search")中。然后它将移动到Sheet的下一行。

请参阅以下代码：

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

我保留了您的Found和i代码，以防您需要其他内容，但此代码不需要使用它来复制每个工作表中包含搜索字的每一行。< / p>

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

2 个答案: