VBA工作表数据提取search多个值
我的任务是从工作簿中的每月工作表中抽取两行特定的数据。
使用MyVal和search框的当前代码仅与一个search兼容。 如何将代码和search框function更改为与多个search兼容？
目前的代码如下所示：
Sub Set_Hyper() ' Object variables Dim wks As Excel.Worksheet Dim rCell As Excel.Range Dim fFirst As String ' {i} will act as our counter Dim i As Long ' Use an input box to type in the search criteria Dim MyVal As String MyVal = InputBox("What are you searching for", "Search-Box", "") ' if we don't have anything entered, then exit the procedure If MyVal = "" Then Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False ' Add a heading to the sheet with the specified search value With Cells(1, 1) .Value = "Found " & MyVal & " in the Link below:" .EntireColumn.AutoFit .HorizontalAlignment = xlCenter End With i = 2 ' Begin looping: ' We are checking all the Worksheets in the Workbook For Each wks In ActiveWorkbook.Worksheets If wks.Name <> "Data" Then ' We are checking all cells, we don't need the SpecialCells method ' the Find method is fast enough With wks.Range("A:A") ' Using the find method is faster: ' Here we are checking column "A" that only have {myVal} explicitly Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False) ' If something is found, then we keep going If Not rCell Is Nothing Then ' Store the first address fFirst = rCell.Address Do ' Link to each cell with an occurence of {MyVal} rCell.Hyperlinks.Add Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 2) Set rCell = .FindNext(rCell) i = i + 1 'Increment our counter Loop While Not rCell Is Nothing And rCell.Address <> fFirst End If End With End If Next wks ' Explicitly clear memory Set rCell = Nothing ' If no matches were found, let the user know If i = 2 Then MsgBox "The value {" & MyVal & "} was not found on any sheet", 64, "No Matches" Cells(1, 1).Value = "" End If ' Reset application settings Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 我在想你可以做的是用下面的控件创build一个UserForm：
一个文本框一个列表框一个向列表框添加文本的button另一个运行VBA的button
文本框可以包含searchstring。 当您点击button执行以下操作时，您可以创build一个事件：
1）将文本从文本框添加到列表框。 查找AddItem方法来执行此操作。 2）清除文本框内容，可以添加新的值。
一旦添加完成，您可以在代码中添加另一个for循环，以添加到列表框中的每个项目。 这样，您可以根据添加的内容进行多次search。
希望这有助于:)