Excel VBA在一次search中search最多15个值

我试图运行一个macros,它允许用户在一次search中search多达15个值。 用户有时可能只search1个值,但最终用户希望此选项可用。 我现在的代码在Sheet1search一个值,当发现它将整个行复制到Sheet2 ,效果很好。 现在我正在尝试多达15个值。 我目前的代码如下:

 Sub FindValues()
    Dim LSearchRow As Integer
    Dim rw As Integer,cl As Range,LSearchValue As Long,LCopyToRow As Integer

    Sheet2.Cells.Clear
    Sheet1.Select

   在错误转到Err_Execute

 这是为了让最终用户input所需的A / C进行search

     LSearchValue = InputBox(“请input要search的值”,“input值”)
     LCopyToRow = 2

    对于rw = 1到1555
        对于每个cl在范围内(“D”&rw&“:M”&rw)
            如果cl = LSearchValue那么
                 cl.EntireRow.Copy
                     “目标:=工作表( “Sheet2的”)
                     '.Rows(LCopyToRow&“:”&LCopyToRow)
                表( “Sheet2的”)。select
                行(LCopyToRow&“:”&LCopyToRow)。select
                     'Selection.PasteSpecial粘贴:= xlPasteValuesAndNumberFormats
                 Selection.PasteSpecial粘贴:= xlPasteValuesAndNumberFormats,操作:= _
                 xlNone,SkipBlanks:= False,Transpose:= False
              “将计数器移动到下一行
                 LCopyToRow = LCopyToRow + 1     
              '返回Sheet1继续search
                表( “工作表Sheet1”)。select  
            万一
             'LSearchRow = LSearchRow + 1

        下一个cl
    下一个rw

 “在单元格A3上的位置
 'Application.CutCopyMode = False
 “Selection.Copy

    表( “Sheet2的”)。select
     Cells.Select
     Selection.PasteSpecial粘贴:= xlPasteFormats,操作:= xlNone,_
     SkipBlanks:= False,Transpose:= False
     Application.CutCopyMode = False

     Sheet2.Select


     MsgBox“所有匹配的数据已被复制”。


    退出小组

 Err_Execute:

    MsgBox“发生错误”。

结束小组

尝试下面的代码。 您可能希望使search项的input更加健壮,因为如果他们单击取消,或input任何非数字值,您将收到一个错误。

 Option Explicit Sub FindValues() Dim LSearchRow As Integer Dim rw As Integer, cl As Range, LSearchValue As Long, LCopyToRow As Integer Dim iHowMany As Integer Dim aSearch(15) As Long Dim i As Integer On Error GoTo Err_Execute Sheet2.Cells.Clear Sheet1.Select iHowMany = 0 LSearchValue = 99 'this for the end user to input the required A/C to be searched Do While LSearchValue <> 0 LSearchValue = InputBox("Please enter a value to search for. Enter a zero to indicate finished entry.", "Enter Search value") If LSearchValue <> 0 Then iHowMany = iHowMany + 1 If iHowMany > 15 Then MsgBox "You are limited to 15 search numbers.", vbOKOnly, "Limit reached" iHowMany = 15 Exit Do End If aSearch(iHowMany) = LSearchValue End If Loop If iHowMany = 0 Then MsgBox "No selections entered.", vbOKOnly + vbCritical, "No Search data" Exit Sub End If LCopyToRow = 2 For rw = 1 To 1555 For Each cl In Range("D" & rw & ":M" & rw) '------------------------------------------------ For i = 1 To iHowMany Debug.Print cl.Row & vbTab & cl.column LSearchValue = aSearch(i) If cl = LSearchValue Then cl.EntireRow.Copy 'Destination:=Worksheets("Sheet2") '.Rows(LCopyToRow & ":" & LCopyToRow) Sheets("Sheet2").Select Rows(LCopyToRow & ":" & LCopyToRow).Select 'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False 'Move counter to next row LCopyToRow = LCopyToRow + 1 'Go back to Sheet1 to continue searching Sheets("Sheet1").Select End If Next i 'LSearchRow = LSearchRow + 1 Next cl Next rw 'Position on cell A3 'Application.CutCopyMode = False 'Selection.Copy Sheets("Sheet2").Select Cells.Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Sheet2.Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred: " & Err.Number & vbTab & Err.Description Exit Sub Resume Next End Sub