VBA实现查找下一个匹配项并在UserForm逐次展示数据

问题背景 #

本人是编程及Visual Basic新手，自学制作了Excel UserForm用于数据库增删改查，目前实现了按姓氏查找并在UserForm展示数据的功能，但遇到两个问题：

• 当有多个相同姓氏时，当前仅能展示最后一个匹配项（而非第一个），希望实现点击搜索按钮能逐次查找并展示下一个匹配项
• 疑惑当前代码为何会找到最后一个匹配项，而非从上到下的第一个

现有代码 #

Private Sub cmdSearch_Click()
        
        Dim sh As Worksheet
        Set sh = ThisWorkbook.Sheets("Database")
        Dim lr As Long
        lr = sh.Range("B" & Rows.Count).End(xlUp).Row
        Dim i As Long
        
        
     txtSearch.Text = UCase(txtSearch.Text)
       
        
        If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txtSearch.Text) = 0 Then
            MsgBox "No person was found with this Surname!", vbOKOnly + vbInformation, "Error"
            Call Reset
            Call UserForm_Initialize
            txtSearch.SetFocus
            Exit Sub
        End If
    
        For i = 2 To lr
        If sh.Cells(i, "B").Value = txtSearch.Text Then
            txtSurname = sh.Cells(i, "B").Value
            txtRN = sh.Cells(i, "A").Value
            txtOnoma = sh.Cells(i, "C").Value
            txtPatronimo = sh.Cells(i, "D").Value
            txtDate = sh.Cells(i, "E").Value
            '...{more values and data entries at this point}...
        End If
     Next i
     Me.txtSurname.ForeColor = RGB(0, 0, 0)
End Sub

问题分析与解决方案 #

问题2原因：为何找到最后一个匹配项 #

你的For循环是从第2行遍历到最后一行，每次找到匹配项都会覆盖UserForm控件的内容，循环结束后控件里保留的是最后一次匹配的数据，这就是为什么会显示最后一个匹配项。

问题1解决方案：实现逐次查找下一个匹配项 #

要实现点击按钮切换下一个匹配项，需要在模块级别保存当前查找的位置，让每次点击都能从上次找到的位置继续往下找。具体步骤如下：

1. 在UserForm代码模块的最顶部（所有Sub之外）声明一个模块级变量，用来记录当前找到的行号：

Private currentRow As Long ' 记录当前查找的位置

2. 修改cmdSearch_Click事件代码，调整查找逻辑：

Private Sub cmdSearch_Click()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Database")
    Dim lr As Long
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    Dim i As Long
    Dim searchText As String
    
    searchText = UCase(Me.txtSearch.Text)
    
    ' 如果搜索内容变更，重置当前查找位置
    If searchText <> UCase(Me.txtSurname.Text) Then
        currentRow = 1 ' 从第1行之后开始查找
    End If
    
    ' 检查是否存在匹配项
    If Application.WorksheetFunction.CountIf(sh.Range("B:B"), searchText) = 0 Then
        MsgBox "未找到该姓氏的人员！", vbOKOnly + vbInformation, "提示"
        Call Reset
        Call UserForm_Initialize
        Me.txtSearch.SetFocus
        currentRow = 1 ' 重置查找位置
        Exit Sub
    End If
    
    ' 从currentRow的下一行开始查找下一个匹配项
    For i = currentRow + 1 To lr
        If UCase(sh.Cells(i, "B").Value) = searchText Then
            ' 更新UserForm控件值
            Me.txtSurname = sh.Cells(i, "B").Value
            Me.txtRN = sh.Cells(i, "A").Value
            Me.txtOnoma = sh.Cells(i, "C").Value
            Me.txtPatronimo = sh.Cells(i, "D").Value
            Me.txtDate = sh.Cells(i, "E").Value
            ' ...其他控件赋值...
            
            ' 更新当前查找位置
            currentRow = i
            Me.txtSurname.ForeColor = RGB(0, 0, 0)
            Exit Sub ' 找到一个就退出循环，等待下一次点击
        End If
    Next i
    
    ' 如果遍历到末尾没找到，回到开头继续查找
    For i = 2 To currentRow
        If UCase(sh.Cells(i, "B").Value) = searchText Then
            Me.txtSurname = sh.Cells(i, "B").Value
            Me.txtRN = sh.Cells(i, "A").Value
            Me.txtOnoma = sh.Cells(i, "C").Value
            Me.txtPatronimo = sh.Cells(i, "D").Value
            Me.txtDate = sh.Cells(i, "E").Value
            ' ...其他控件赋值...
            
            currentRow = i
            Me.txtSurname.ForeColor = RGB(0, 0, 0)
            MsgBox "已到最后一个匹配项，回到第一个", vbInformation
            Exit Sub
        End If
    Next i
End Sub

3. 补充说明：

• 模块级变量currentRow会在UserForm打开时自动初始化，每次搜索新姓氏时会重置为1，确保从数据开头查找
• 第一次点击按钮找到第一个匹配项，再次点击会查找下一个，直到最后一个匹配项后自动回到第一个
• 加入UCase统一大小写，避免因大小写差异导致匹配失败

内容的提问来源于stack exchange，提问作者epaeon