整个工作簿中的InputBox中的FindNext

时间:2015-04-15 18:28:51

标签: excel vba excel-vba

Noob在这里。我在这个网站上发现了很多代码,并且要感谢所有贡献者。

我的问题是我有一个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"

2 个答案:

答案 0 :(得分:1)

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

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行代码 - 而不是整个子程序。

答案 1 :(得分:0)

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