选择符合查找条件的所有单元格

时间:2015-10-12 09:14:06

标签: excel vba excel-vba find match

我正在编写一个简单的宏来搜索表中的值。我知道搜索的值多次出现在文档中。但我的宏只找到表中的第一个值。我想选择具有我正在寻找的值的所有行。然后我想复制选定的行并将它们复制到“sheet2”。有人可以帮我调整我的宏吗? THX

Sub Vyhladat()

Sheets("Sheet1").Columns(24).Find(What:=InputBox("Please enter your LR number", "Search")).Select
ActiveCells.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select

Do
If IsEmpty(ActiveCell.Value) Then
    ActiveCell.PasteSpecial xlPasteValues
    End
Else
    ActiveCell.Offset(1, 0).Select
End If

Loop

End Sub

1 个答案:

答案 0 :(得分:2)

以下是如何操作(找到第一个匹配,然后使用FindNext()方法循环):

Sub test_Jean()
Dim FirstAddress As String, _
    cF As Range, _
    RowsToCopy As String

ActiveSheet.Cells(1, 24).Activate
With ActiveSheet.Columns(24)
    'First, define properly the Find method
    Set cF = .Find(What:=InputBox("Please enter your LR number", "Search"), _
                After:=ActiveCell, _
                LookIn:=xlFormulas, _
                LookAt:=xlPart, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False)

    'If there is a result, keep looking with FindNext method
    If Not cF Is Nothing Then
        FirstAddress = cF.Address
        Do
            cF.EntireRow.Copy
            Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
            Set cF = .FindNext(cF)
        'Look until you find again the first result
        Loop While Not cF Is Nothing And cF.Address <> FirstAddress
    End If
End With

End Sub