在整个工作簿中从InputBox中查找Next



此处没有。我在这个网站上找到了很多代码,我想对所有贡献者表示感谢。

我的问题是我有一个UserForm。我点击一个按钮调出一个InputBox,在那里他们输入一个值来搜索银行名称、银行名称、企业名称等。

我有进行搜索的代码,没有问题,但我希望能够继续搜索InputBox值的所有实例。例如,搜索"Smith"这个名字,如果第一个不是我需要的,继续搜索,直到我找到我要找的那个。

Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
On Error Resume Next
strName = InputBox("Please Enter Search Value." & vbNewLine & "Entry Must Be Exact Cell Value!", "Search Value")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart)
If Not rFound Is Nothing Then
firstaddress = rFound.Address
Application.Goto rFound, True
Exit Sub
End If
End With
Next ws
On Error GoTo 0
MsgBox "Merchant not found. Please make sure you typed it correctly.", vbOKOnly + vbCritical, "Invalid Entry"

您需要修改您的搜索,以便您的代码"记住"它停止的位置,如下所示:

Option Explicit
Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
Static First as Range
'On Error Resume Next
if First is Nothing Then   'we haven't found anything yet
Set First = Worksheets(1).Cells(1,1)  'start searching at the beginning
End If
strName = InputBox("Please Enter Search Value." & vbNewLine & "Entry Must Be Exact Cell Value!", "Search Value")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=First, LookIn:=xlValues, LookAt:=xlPart)
while Not rFound Is Nothing
if first is nothing then
First = rFound   'store off this address for use in our next search
end if
if first <> rFound Then    'we've found a NEW instance of the search item
firstaddress = rFound.Address
Application.Goto rFound, True
MsgBox "Found one!"
Set rFound = .Find(What:=strName, After:=rFound, LookIn:=xlValues, LookAt:=xlPart)
else  'we're back at the start, so jump out of the loop
set rFound = Nothing
End If
wEnd
End With
Next ws
On Error GoTo 0
MsgBox "Merchant not found. Please make sure you typed it correctly.", vbOKOnly + vbCritical, "Invalid Entry"

几点:

  • 我添加了Option Explicit,这意味着您的代码现在不会运行,因为您从未声明过firstaddress。从功能区启用该选项对您的理智至关重要:"工具"|"选项"|"编辑器",然后选中"Require Variable Declaration">
  • 通过将First声明为Static,它将在对搜索例程的调用之间保持设置状态。这样,由于我们将First输入到.Find()函数中,它将从停止的位置开始搜索
  • 如果需要从头开始搜索,可以存储"最后一个"搜索词-如果当前词与上一个词不同,则重置set First = Worksheets(1).Cells(1,1)
  • 附加说明-On Error Resume Next非常有限的情况下很有用。这不是其中之一。它允许你忽略代码中的错误,这样你就可以立即处理它,这在这种情况下不是你想要的。重新启用默认错误处理的后续On Error Goto 0实际上不应该超过1行代码,而不是整个子程序

VBA已经有了用于此目的的.FindNext()方法:

Sub SO()
Dim inputString     As String
Dim foundCell       As Excel.Range
Dim wSheet          As Excel.Worksheet
Dim foundAddress    As String
inputString = InputBox("Please enter search term:", "Search")
For Each wSheet In ActiveWorkbook.Worksheets
Set foundCell = wSheet.Cells.Find(inputString, , -4163, 2)
If Not foundCell Is Nothing Then
Application.Goto foundCell, True
foundAddress = foundCell.Address
If MsgBox("Match in " & wSheet.Name & " (" & foundCell.Address & ")" & vbCrLf & "Continue?", 68, "Match Found") = vbYes Then
Do
Set foundCell = wSheet.Cells.FindNext(foundCell)
If Not foundCell Is Nothing And Not foundCell.Address = foundAddress Then
Application.Goto foundCell, True
Else
Exit Do
End If
Loop While MsgBox("Match in " & wSheet.Name & " (" & foundCell.Address & ")" & vbCrLf & "Continue?", 68, "Match Found") = vbYes And _
Not foundCell Is Nothing And Not foundCell.Address = foundAddress
Set foundCell = wSheet.Cells.FindNext(foundCell)
End If
End If
If MsgBox("All matches in this sheet found - move to next sheet?", 68, "Next Sheet?") = vbNo Then Exit Sub
Next wSheet
End Sub

最新更新