将 '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
我有 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