我创建了一个用户表单,用于搜索工作表上的唯一ID,并显示位于同一行的关联数据。
我已经使用了另一个StackOverflow问题,但它并不能完全适用于我
我搜索的唯一ID有多个数据集。我点击下面的代码,点击查找,显示第一个找到的记录,然后弹出一个消息框,告诉用户表单中有多少记录。单击“确定”后,用户窗体将关闭。
我想编辑它,所以在单击OK后,用户可以单击FindNext按钮,userform将显示与原始搜索匹配的所有其他记录。
以下是代码:
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
由于
答案 0 :(得分:0)
FindNext_Click
的代码使用了显示的最后一行被设置为当前选择的事实(请参阅anchorCell.Select
中的updateFields
)。问题是,在这些调用之间用户可能选择了另一个单元格甚至是另一个工作表,会发生运行时错误。
我建议另一种方法,只有两个函数,一个计算匹配并启动搜索,另一个负责更新和下一个&#34;
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