VBA UserForm查找多个记录,显示和循环

时间:2017-02-08 17:18:53

标签: excel vba excel-vba userform

我创建了一个用户表单,用于搜索工作表上的唯一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

由于

1 个答案:

答案 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