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