VBA UserForm 查找多条记录,显示并循环显示
VBA UserForm Find multiple records, display and cycle through
我正在创建一个用户表单,它在 sheet 上搜索唯一 ID 并显示位于同一行的关联数据。
我已经使用了另一个 Whosebug 问题的帮助,但它并不完全适合我
我正在搜索的唯一 ID 有多个数据集。我在下面获得的代码在单击“查找”时会显示第一个找到的记录,并弹出一个消息框,告诉用户 sheet 中有多少条记录。单击“确定”后,用户表单关闭。
我想对其进行编辑,以便在单击“确定”后,用户可以单击“查找下一个”按钮,用户表单将显示与原始搜索匹配的所有其他记录。
代码如下:
Private Sub FindNext_Click()
Dim nextCell As Range
Set nextCell = Cells.FindNext(After:=ActiveCell)
'FindNext loops round to the initial cell if it finds no other so we test for it
If Not nextCell.Address(external:=True) = ActiveCell.Address(external:=True) Then
updateFields anchorCell:=nextCell
End If
End Sub
Private Sub Find_Click()
Worksheets("Master").Activate
Dim strFind As String
Dim FirstAddress As String
Dim rSearch As Range
Set rSearch = Range("a1", Range("a65536").End(xlUp))
Dim f As Integer
Dim c As Object
strFind = Me.TextBox1.Value
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then
updateFields anchorCell:=c
FirstAddress = c.Address
Do
f = f + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
Case vbCancel
End Select
Me.Height = frmMax
End If
Else: MsgBox strFind & " not listed"
End If
End With
End Sub
Private Sub updateFields(anchorCell As Range)
anchorCell.Select
With Me
.TextBox2.Value = anchorCell.Offset(0, 2).Value
.TextBox3.Value = anchorCell.Offset(0, 3).Value
.TextBox4.Value = anchorCell.Offset(0, 4).Value
.TextBox6.Value = anchorCell.Offset(0, 13).Value
.TextBox7.Value = anchorCell.Offset(0, 14).Value
.TextBox8.Value = anchorCell.Offset(0, 15).Value
.TextBox9.Value = anchorCell.Offset(0, 16).Value
.TextBox10.Value = anchorCell.Offset(0, 17).Value
.TextBox11.Value = anchorCell.Offset(0, 18).Value
.TextBox12.Value = anchorCell.Offset(0, 19).Value
.TextBox13.Value = anchorCell.Offset(0, 20).Value
.TextBox14.Value = anchorCell.Offset(0, 21).Value
.TextBox20.Value = anchorCell.Offset(0, 22).Value
End With
End Sub
谢谢
FindNext_Click
的代码使用了显示的最后一行被设置为当前选择的事实(参见 updateFields
中的 anchorCell.Select
)。问题是,在这些调用之间,用户可能选择了另一个单元格甚至另一个工作表,会发生运行时错误。
我建议另一种只有两个功能的方法,一个计算匹配项并启动搜索,另一个负责更新和下一个
Option Explicit
Private anchor As Range ' keeps track of the last shown row
Private Sub Find_Click()
' Only Displays the number of matches and delegates the updating to FidNext
Dim count As Long
count = WorksheetFunction.CountIf(Worksheets("Master").UsedRange.Columns("A"), TextBox1.Value)
If count < 1 Then
msgBox TextBox1.Value & " not listed"
FindNext.Enabled = False
Exit Sub
End If
FindNext.Enabled = True
Set anchor = Worksheets("Master").Range("A65536").End(xlUp)
FindNext_Click ' Now delegate the work to FindNext
End Sub
Private Sub FindNext_Click()
'responsible of updating the userform and scrolling to the next field
Set anchor = Worksheets("Master").UsedRange.Columns("A").Find(TextBox1.Value, anchor)
TextBox2.Value = anchor.offset(0, 2).Value
TextBox3.Value = anchor.offset(0, 3).Value
TextBox4.Value = anchor.offset(0, 4).Value
TextBox6.Value = anchor.offset(0, 13).Value
TextBox7.Value = anchor.offset(0, 14).Value
TextBox8.Value = anchor.offset(0, 15).Value
TextBox9.Value = anchor.offset(0, 16).Value
TextBox10.Value = anchor.offset(0, 17).Value
TextBox11.Value = anchor.offset(0, 18).Value
TextBox12.Value = anchor.offset(0, 19).Value
TextBox13.Value = anchor.offset(0, 20).Value
TextBox14.Value = anchor.offset(0, 21).Value
TextBox20.Value = anchor.offset(0, 22).Value
Worksheets("Master").Activate
anchor.EntireRow.Activate
End Sub
我正在创建一个用户表单,它在 sheet 上搜索唯一 ID 并显示位于同一行的关联数据。
我已经使用了另一个 Whosebug 问题的帮助,但它并不完全适合我
我正在搜索的唯一 ID 有多个数据集。我在下面获得的代码在单击“查找”时会显示第一个找到的记录,并弹出一个消息框,告诉用户 sheet 中有多少条记录。单击“确定”后,用户表单关闭。
我想对其进行编辑,以便在单击“确定”后,用户可以单击“查找下一个”按钮,用户表单将显示与原始搜索匹配的所有其他记录。
代码如下:
Private Sub FindNext_Click()
Dim nextCell As Range
Set nextCell = Cells.FindNext(After:=ActiveCell)
'FindNext loops round to the initial cell if it finds no other so we test for it
If Not nextCell.Address(external:=True) = ActiveCell.Address(external:=True) Then
updateFields anchorCell:=nextCell
End If
End Sub
Private Sub Find_Click()
Worksheets("Master").Activate
Dim strFind As String
Dim FirstAddress As String
Dim rSearch As Range
Set rSearch = Range("a1", Range("a65536").End(xlUp))
Dim f As Integer
Dim c As Object
strFind = Me.TextBox1.Value
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then
updateFields anchorCell:=c
FirstAddress = c.Address
Do
f = f + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
Case vbCancel
End Select
Me.Height = frmMax
End If
Else: MsgBox strFind & " not listed"
End If
End With
End Sub
Private Sub updateFields(anchorCell As Range)
anchorCell.Select
With Me
.TextBox2.Value = anchorCell.Offset(0, 2).Value
.TextBox3.Value = anchorCell.Offset(0, 3).Value
.TextBox4.Value = anchorCell.Offset(0, 4).Value
.TextBox6.Value = anchorCell.Offset(0, 13).Value
.TextBox7.Value = anchorCell.Offset(0, 14).Value
.TextBox8.Value = anchorCell.Offset(0, 15).Value
.TextBox9.Value = anchorCell.Offset(0, 16).Value
.TextBox10.Value = anchorCell.Offset(0, 17).Value
.TextBox11.Value = anchorCell.Offset(0, 18).Value
.TextBox12.Value = anchorCell.Offset(0, 19).Value
.TextBox13.Value = anchorCell.Offset(0, 20).Value
.TextBox14.Value = anchorCell.Offset(0, 21).Value
.TextBox20.Value = anchorCell.Offset(0, 22).Value
End With
End Sub
谢谢
FindNext_Click
的代码使用了显示的最后一行被设置为当前选择的事实(参见 updateFields
中的 anchorCell.Select
)。问题是,在这些调用之间,用户可能选择了另一个单元格甚至另一个工作表,会发生运行时错误。
我建议另一种只有两个功能的方法,一个计算匹配项并启动搜索,另一个负责更新和下一个
Option Explicit
Private anchor As Range ' keeps track of the last shown row
Private Sub Find_Click()
' Only Displays the number of matches and delegates the updating to FidNext
Dim count As Long
count = WorksheetFunction.CountIf(Worksheets("Master").UsedRange.Columns("A"), TextBox1.Value)
If count < 1 Then
msgBox TextBox1.Value & " not listed"
FindNext.Enabled = False
Exit Sub
End If
FindNext.Enabled = True
Set anchor = Worksheets("Master").Range("A65536").End(xlUp)
FindNext_Click ' Now delegate the work to FindNext
End Sub
Private Sub FindNext_Click()
'responsible of updating the userform and scrolling to the next field
Set anchor = Worksheets("Master").UsedRange.Columns("A").Find(TextBox1.Value, anchor)
TextBox2.Value = anchor.offset(0, 2).Value
TextBox3.Value = anchor.offset(0, 3).Value
TextBox4.Value = anchor.offset(0, 4).Value
TextBox6.Value = anchor.offset(0, 13).Value
TextBox7.Value = anchor.offset(0, 14).Value
TextBox8.Value = anchor.offset(0, 15).Value
TextBox9.Value = anchor.offset(0, 16).Value
TextBox10.Value = anchor.offset(0, 17).Value
TextBox11.Value = anchor.offset(0, 18).Value
TextBox12.Value = anchor.offset(0, 19).Value
TextBox13.Value = anchor.offset(0, 20).Value
TextBox14.Value = anchor.offset(0, 21).Value
TextBox20.Value = anchor.offset(0, 22).Value
Worksheets("Master").Activate
anchor.EntireRow.Activate
End Sub