时间戳

首页 > 解决方案 > 将“findnext”功能合并到现有的“查找”代码中？

excel - 将“findnext”功能合并到现有的“查找”代码中？

问题描述

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

当调用搜索时，用户会看到一个用户窗体，焦点在一个 ComboBox 上，它要求用户选择一个选项，然后在 TextBox 中输入一个搜索词（为方便起见，称为 TextBox1）。他们单击“搜索”，第一个匹配详细信息显示在表单内的许多其他（禁用）文本框中。

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

如何在现有代码中实现“查找下一个”功能，以便当用户第二次（或第三次或第四次等）单击搜索按钮时，它会在用户表单中显示下一个匹配的详细信息，如果没有找到其他匹配项，显示一个 MsgBox 建议“没有找到更多匹配项”？

我以前见过并使用过 find next VBA 函数，但不是在这种情况下，也不是当我有一个用户表单来填充新结果时。

标签： excelvbauserform

解决方案

私有范围变量

  • 由于您在每次搜索后退出程序，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

推荐阅读