将 'findnext' 函数合并到现有的 'find' 代码中?

Incorporating 'findnext' function into existing 'find' code?

我有 VBA 代码可以正常工作并显示用户窗体中的第一个匹配项。

调用搜索时,系统会向用户显示一个用户表单,焦点位于 ComboBox 上,这需要用户 select 一个选项,然后在 TextBox(为方便起见称为 TextBox1)中输入搜索词。他们单击 'Search',第一个匹配的详细信息显示在表单内的许多其他(禁用)文本框中。

Private Sub btnDemProg_Click()
    Application.ScreenUpdating = False
    If ComboBox1.Value = "" Then
        MsgBox ("Please select a column.")
        ComboBox1.SetFocus
        Exit Sub
    End If
    If TextBox1.Value = "" Then
        MsgBox ("Please enter a search criterium.")
        TextBox1.SetFocus
        Exit Sub
    End If
    Dim sh As Worksheet, colFnd As Range, crit As Range
    Set sh = Sheets("DEMANDS")
    Set colFnd = sh.Rows(1).find(ComboBox1.Value, , xlValues, xlWhole)
    If Not colFnd Is Nothing Then
        Set crit = sh.Columns(colFnd.Column).find(TextBox1.Value, , xlValues, xlPart)
        If Not crit Is Nothing Then
            With sh
                Me.DmdNo.Value = .Cells(crit.Row, 1)
                Me.DmdDate.Value = .Cells(crit.Row, 2)
                Me.nsn.Value = .Cells(crit.Row, 3)
                Me.PTNum.Value = .Cells(crit.Row, 4)
                Me.desc.Value = .Cells(crit.Row, 5)
                Me.qty.Value = .Cells(crit.Row, 6)
                Me.DofQ.Value = .Cells(crit.Row, 7)
                Me.RDD.Value = .Cells(crit.Row, 8)
                Me.Sect.Value = .Cells(crit.Row, 18)
                Me.POC.Value = .Cells(crit.Row, 20)
                Me.ainu.Value = .Cells(crit.Row, 21)
                Me.inv.Value = .Cells(crit.Row, 22)
                Me.trilogy.Value = .Cells(crit.Row, 17)
                Me.ACtailNo.Value = .Cells(crit.Row, 16)
                Me.TechDoc.Value = .Cells(crit.Row, 28)
                Me.ACSys.Value = .Cells(crit.Row, 19)
                Me.ADF_LIM_Number.Value = .Cells(crit.Row, 25)
                Me.SNOW.Value = .Cells(crit.Row, 26)
                Me.reason.Value = .Cells(crit.Row, 27)
                Me.ProgText.Value = .Cells(crit.Row, 31)
            End With
        Else
            MsgBox "I cannot find this demand. Has it been cancelled/satisfied?"
        End If
    End If

如何在现有代码中实现 'find next' 函数,以便当用户第二次(或第三次、或第四次等)单击搜索按钮时,它会显示下一次匹配的详细信息用户窗体,如果未找到其他匹配项,则显示一个 MsgBox,提示“未找到更多匹配项”?

我以前见过并使用过查找下一个 VBA 函数,但不是在这种情况下,也不是在我有一个用户表单来填写新结果时。

私有范围变量

  • 由于您在每次搜索后退出程序,FindNext 无法帮助您。
  • Private crit As Range用于存储当前找到的单元格(范围)作为After(第二个)参数Find方法的下一次搜索(在后续程序的调用)。
  • xlFormulas 允许隐藏行。
  • 未测试。

代码

Option Explicit

Private crit As Range

Private Sub btnDemProg_Click()
    Application.ScreenUpdating = False
    If ComboBox1.Value = "" Then
        MsgBox ("Please select a column.")
        ComboBox1.SetFocus
        Exit Sub
    End If
    If TextBox1.Value = "" Then
        MsgBox ("Please enter a search criterium.")
        TextBox1.SetFocus
        Exit Sub
    End If
    Dim sh As Worksheet, colFnd As Range, CheckRow As Long
    Set sh = Sheets("DEMANDS")
    Set colFnd = sh.Rows(1).Find(ComboBox1.Value, , xlFormulas, xlWhole)
    If Not colFnd Is Nothing Then
        With sh.Columns(colFnd.Column)
            If crit Is Nothing Then
                Set crit = .Find(TextBox1.Value, , xlFormulas, xlPart)
            Else
                If Intersect(.Offset, crit) Is Nothing Then
                    Set crit = .Find(TextBox1.Value, , xlFormulas, xlPart)
                Else
                    CheckRow = crit.Row
                    Set crit = .Find(TextBox1.Value, crit, xlFormulas, xlPart)
                End If
            End If
        End With
        If Not crit Is Nothing Then
            If crit.Row > CheckRow Then
                With sh
                    Me.DmdNo.Value = .Cells(crit.Row, 1)
                    Me.DmdDate.Value = .Cells(crit.Row, 2)
                    Me.nsn.Value = .Cells(crit.Row, 3)
                    Me.PTNum.Value = .Cells(crit.Row, 4)
                    Me.desc.Value = .Cells(crit.Row, 5)
                    Me.qty.Value = .Cells(crit.Row, 6)
                    Me.DofQ.Value = .Cells(crit.Row, 7)
                    Me.RDD.Value = .Cells(crit.Row, 8)
                    Me.Sect.Value = .Cells(crit.Row, 18)
                    Me.POC.Value = .Cells(crit.Row, 20)
                    Me.ainu.Value = .Cells(crit.Row, 21)
                    Me.inv.Value = .Cells(crit.Row, 22)
                    Me.trilogy.Value = .Cells(crit.Row, 17)
                    Me.ACtailNo.Value = .Cells(crit.Row, 16)
                    Me.TechDoc.Value = .Cells(crit.Row, 28)
                    Me.ACSys.Value = .Cells(crit.Row, 19)
                    Me.ADF_LIM_Number.Value = .Cells(crit.Row, 25)
                    Me.SNOW.Value = .Cells(crit.Row, 26)
                    Me.reason.Value = .Cells(crit.Row, 27)
                    Me.ProgText.Value = .Cells(crit.Row, 31)
                End With
            Else
                Set crit = Nothing
                MsgBox "No further matches found."
            End If
        Else
            MsgBox "I cannot find this demand. Has it been cancelled/satisfied?"
        End If
    End If
End Sub