Question

我正在尝试在文档的E列中搜索特定术语，并在找到时将找到的整行复制到同一文档中的另一个工作表中。下面的代码能够完成我想要做的事情，但它只会在第一次出现搜索时结束，并且我需要它继续，直到找到所有出现并复制和粘贴。任何和所有帮助将不胜感激。

Sub Macro3()
    Dim LSearchRow As Integer Dim LCopyToRow As Integer
    On Error GoTo Err_Execute
    'Start search in row 2 LSearchRow = 2
    'Start copying data to row 2 in Sheet2 (row counter variable) LCopyToRow = 2
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
        'If value in column E = "Aries Radio Control", copy entire row to Sheet2
        If InStr(1, Range("E" & CStr(LSearchRow)).Value, "Aries Radio Control") > 0 Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet ARC in next row
            Sheets("ARC").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("sheet1").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

您将需要使用循环来实现您想要的效果。来自MSDN https://msdn.microsoft.com/en-us/library/office/ff839746(v=office.15).aspx#Anchor_2的示例如下。

This example finds all cells in the range A1:A500 on worksheet one that contain the value 2 and changes it to 5.

With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With

搜索特定术语的1列，并在找到时将整行复制到另一个工作表中

1 个答案: