Select 所有符合我的查找条件的单元格

Question

我正在编写一个简单的宏来搜索我在 table 中的值。我知道搜索值多次出现在文档中。但是我的宏在 table 中只找到第一个值。我想要 select 所有具有我正在寻找的值的行。然后我想复制 selected 行并将它们复制到 "sheet2"。有人可以帮我调整我的宏吗？感谢

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

Answer 1

方法如下（找到第一个匹配项，然后使用 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

Select 所有符合我的查找条件的单元格

Select all cells matching my find criteria

excel

vba

find

match