Excel VBA问题：ListBox仅显示搜索值而非整行及代码优化求助

1. ListBox仅显示单个值的核心修复 #

原代码中Me.SearchDisplayX.AddItem Rng.rows是错误用法：AddItem仅支持添加单个字符串，无法直接导入整行对象。要将匹配的整行数据导入ListBox，需先确保ListBox的ColumnCount属性设置为8（与你的表头列数一致），再替换为以下代码：

If Not Rng Is Nothing Then
    Application.Goto Rng, True
    ' 新增整行数据到ListBox
    Me.SearchDisplayX.AddItem
    Dim col As Integer
    For col = 0 To 7 ' 遍历8列（索引0到7）
        Me.SearchDisplayX.List(Me.SearchDisplayX.ListCount - 1, col) = Rng.EntireRow.Cells(1, col + 1).Value
    Next col
End If

2. 其他代码问题排查与修复 #

（1）Find仅返回第一个匹配项，遗漏后续结果 #

原代码的Find只会定位第一个匹配单元格，需结合FindNext循环遍历所有匹配项：

Dim firstAddress As String
Set Rng = .Find(What:=CINorRC, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
If Not Rng Is Nothing Then
    firstAddress = Rng.Address
    Do
        ' 这里插入导入ListBox的代码（同核心修复部分）
        Set Rng = .FindNext(Rng)
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
End If

（2）变量未声明导致潜在错误 #

在代码开头添加Option Explicit强制变量声明，同时补充Dim Rng As Range，避免因变量类型模糊引发的bug。

（3）"未找到"提示逻辑完全反转 #

原代码If Not Rng Is Nothing Then MsgBox "Nothing found"逻辑错误，需改为If Not foundAny Then MsgBox "Nothing found"，同时新增foundAny布尔变量标记是否找到匹配结果。

（4）表头重复添加问题 #

每次运行代码前先清空ListBox，避免重复插入表头：

With Me.SearchDisplayX
    .Clear ' 清空原有内容
    .ColumnCount = 8
    .AddItem
    ' 以下为表头赋值代码（保留原内容）
End With

（5）InputBox冗余判断优化 #

简化输入验证逻辑，确保空输入或取消操作后直接退出：

CINorRC = InputBox("Entrez un CIN ou RC correct.")
If StrPtr(CINorRC) = 0 Then ' 用户点击取消
    Exit Sub
ElseIf Trim(CINorRC) = "" Then ' 空输入
    MsgBox "Err..."
    Exit Sub
End If

3. 完整修复后的代码 #

Option Explicit

Sub SearchAndDisplay()
    Dim CINorRC As String
    CINorRC = InputBox("Entrez un CIN ou RC correct.")
    
    ' 处理输入取消或空值
    If StrPtr(CINorRC) = 0 Then
        Exit Sub
    ElseIf Trim(CINorRC) = "" Then
        MsgBox "Err..."
        Exit Sub
    End If
    
    ' 初始化ListBox：清空并添加表头
    With Me.SearchDisplayX
        .Clear
        .ColumnCount = 8 ' 设置列数匹配表头
        .AddItem
        .List(.ListCount - 1, 0) = "CIN/RC"
        .List(.ListCount - 1, 1) = "ART"
        .List(.ListCount - 1, 2) = "Nom"
        .List(.ListCount - 1, 3) = "Nature"
        .List(.ListCount - 1, 4) = "LI"
        .List(.ListCount - 1, 5) = "**"
        .List(.ListCount - 1, 6) = "DP"
        .List(.ListCount - 1, 7) = "OBS"
    End With
    
    Dim ws As Worksheet
    Dim Rng As Range
    Dim firstAddress As String
    Dim col As Integer
    Dim foundAny As Boolean
    foundAny = False ' 标记是否找到结果
    
    If Trim(CINorRC) <> "" Then
        For Each ws In ActiveWorkbook.Sheets
            With ws.Range("A2:L999")
                Set Rng = .Find(What:=CINorRC, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                                
                If Not Rng Is Nothing Then
                    firstAddress = Rng.Address
                    Do
                        foundAny = True
                        Application.Goto Rng, True
                        ' 添加整行数据到ListBox
                        Me.SearchDisplayX.AddItem
                        For col = 0 To 7
                            Me.SearchDisplayX.List(Me.SearchDisplayX.ListCount - 1, col) = Rng.EntireRow.Cells(1, col + 1).Value
                        Next col
                        Set Rng = .FindNext(Rng)
                    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
                End If
            End With
        Next ws
        
        ' 提示未找到结果
        If Not foundAny Then
            MsgBox "Nothing found"
        End If
    End If
End Sub

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