Excel VBA 一次搜索最多可搜索 15 个值
Posted
技术标签:
【中文标题】Excel VBA 一次搜索最多可搜索 15 个值【英文标题】：Excel VBA to search for up to 15 values in one search 【发布时间】：2015-01-12 10:42:06 【问题描述】：我正在尝试运行一个宏，它允许用户在一次搜索中最多搜索 15 个值。用户有时可能只搜索 1 个值，但最终用户希望此选项可用。我现在拥有的代码在Sheet1 中搜索一个值，当找到它时，它将整行复制到Sheet2，效果很好。现在我正在尝试最多 15 个值。我当前的代码如下：
【问题讨论】：
我没有看到您试图解释 15 个可能的搜索词的部分。 LSearchValue = InputBox("请输入要搜索的值。", "输入值") LCopyToRow = 2 For rw = 1 To 1555 For Each cl In Range("D" & rw & " :M" & rw) If cl = LSearchValue Then cl.EntireRow.Copy " 此时我正在尝试一个有效的值。我不确定如何将其更改为 15 个值 我希望你不会提示用户 15 次。如果是这样，则保存 15 个值（或与输入的一样多），在输入时计数。然后构建您的循环，使其从 1-15 进行检查（取决于计数），并计算您获得的匹配数。如果匹配 = 用户输入，则复制该行。 另外，如果 ALL 匹配或 ANY 匹配，你会复制吗？ 我复制所有匹配项。即最终用户请求帐户 8188，它会复制整行并继续搜索 8188，直到找不到。因此最终用户希望能够搜索多个帐户。 【参考方案1】：试试下面的代码。您可能希望使搜索词的输入更加可靠，因为如果它们单击“取消”或输入任何非数字值，您将收到错误消息。
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
【讨论】：
你是个天才！非常感谢......你在我的最爱名单上，再次感谢你:)以上是关于Excel VBA 一次搜索最多可搜索 15 个值的主要内容，如果未能解决你的问题，请参考以下文章