VBA实现UserForm文本框搜索单元格并返回对应列值至列表框

功能需求 #

• Excel的A、B、C、D列存储数据，通过UserForm里的TextBox输入搜索字符串
• 点击搜索按钮后，在A、B、C列范围内模糊匹配搜索字符串（不区分大小写）
• 找到匹配的行后，把该行D列的内容添加到ListBox中
• 示例：搜索“Bag”时，ListBox会显示return1、return2、return3

现有VBA代码 #

Private Sub CommandButton3_Click()
    row_num = 1
    Application.ScreenUpdating = False
    searchString = srchtxt.Value
    Me.ListBox2.Clear
    
    ' 输入包含非法字符（非字母、下划线、空格）或纯数字时，直接退出
    If srchtxt.Value Like "*[!.A-Za-z_ ]*" Or IsNumeric(srchtxt.Value) Then
        Exit Sub
    Else
        Do
            DoEvents
            row_num = row_num + 1
            ' 读取当前行A、B、C、D列的值
            item_num = Sheet17.Range("A" & row_num).Value
            item_num1 = Sheet17.Range("B" & row_num).Value
            item_num2 = Sheet17.Range("C" & row_num).Value
            item_desc = Sheet17.Range("D" & row_num).Value
            
            ' 检查A、B、C列是否包含搜索字符串，匹配则添加D列内容到ListBox
            If InStr(1, item_num, searchString, vbTextCompare) > 0 Then
                Me.ListBox2.AddItem item_desc
            ElseIf InStr(1, item_num1, searchString, vbTextCompare) > 0 Then
                Me.ListBox2.AddItem item_desc
            ElseIf InStr(1, item_num2, searchString, vbTextCompare) > 0 Then
                Me.ListBox2.AddItem item_desc
            End If
        ' 固定循环到第10000行
        Loop Until row_num = 10000
    End If
    Application.ScreenUpdating = True
End Sub

代码优化点 #

• 动态获取数据范围：原代码硬编码循环到10000行，换成Sheet17.Cells(Sheet17.Rows.Count, "A").End(xlUp).Row获取A列最后一行，避免空行循环或遗漏数据
• 简化匹配逻辑：把三个ElseIf合并成Or判断，减少重复代码，提升可读性
• 增加空输入处理：当搜索框为空时，弹出提示，避免无意义的循环
• 优化运行性能：循环前关闭Application.EnableEvents，结束后恢复，减少系统资源消耗

优化后的代码示例 #

Private Sub CommandButton3_Click()
    Dim lastRow As Long
    Dim row_num As Long
    Dim searchString As String
    
    ' 关闭屏幕刷新和事件触发，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    searchString = Trim(srchtxt.Value)
    Me.ListBox2.Clear
    
    ' 处理无效输入情况
    If searchString = "" Or searchString Like "*[!.A-Za-z_ ]*" Or IsNumeric(searchString) Then
        MsgBox "请输入有效的搜索字符串（仅允许字母、下划线、空格）", vbExclamation
        GoTo Cleanup
    End If
    
    ' 动态获取A列最后一行数据
    lastRow = Sheet17.Cells(Sheet17.Rows.Count, "A").End(xlUp).Row
    
    ' 从第2行开始循环（假设第1行是表头）
    For row_num = 2 To lastRow
        DoEvents
        ' 合并判断A、B、C列是否包含搜索字符串
        If InStr(1, Sheet17.Cells(row_num, "A").Value, searchString, vbTextCompare) > 0 _
        Or InStr(1, Sheet17.Cells(row_num, "B").Value, searchString, vbTextCompare) > 0 _
        Or InStr(1, Sheet17.Cells(row_num, "C").Value, searchString, vbTextCompare) > 0 Then
            Me.ListBox2.AddItem Sheet17.Cells(row_num, "D").Value
        End If
    Next row_num

Cleanup:
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

内容的提问来源于stack exchange，提问作者Vanitha Rosy VA