VBA用户窗体：实现无重复搜索列表及双击填充控件求助

问题描述 #

我是VBA新手，现有用户窗体可从工作表「TABLE」加载数据到ListBox，双击列表项能将对应数据填充至文本框、ComboBox及复选框，且CheckBox1会根据选中状态切换颜色。新增搜索功能后，虽能筛选结果并去重，但出现复选框显示灰色（值正确但视觉异常）的问题，加载全部数据时显示正常。现需解决该异常并完善搜索功能。

现有代码 #

初始功能代码 #

Sub All_Data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TABLE")
Dim last_Row As Long
last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With Me.ListBox1
     .ColumnHeads = False
     .ColumnCount = 12
     .ColumnWidths = "0,70,60,60,0,0,0,0,0,0,120,0"
     .List = Range(Cells(1, 1), Cells(last_Row, .ColumnCount)).Value
     .RemoveItem 0    
End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
Me.TextBox3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
Me.TextBox5.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
Me.TextBox6.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)
Me.TextBox7.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)
Me.ComboBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7)
Me.Checkbox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8)
Me.Checkbox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)
Me.CheckBox3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 10)
Me.CheckBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 11)
End Sub

Private Sub CheckBox1_Change()
If CheckBox1.Value Then
CheckBox1.ForeColor = &H8000&
Else
CheckBox1.ForeColor = &HC0&
End If
End Sub

Private Sub Workbook_Open()
UserForm1.Show
End Sub

搜索功能代码 #

Private Sub searchButton_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TABLE")
Dim i As Long
Dim x As Long
Dim p As Integer, k As Integer

Me.searchTextBox = LCase(Me.searchTextBox)

If Me.searchTextBox = "" Then
Call All_Data
Exit Sub
End If

With Me.ListBox1
     .Clear
     .ColumnHeads = False
     .ColumnCount = 12
     .ColumnWidths = "0,70,60,60,0,,0,0,0,0,120,0"

For i = 2 To sh.Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To Len(sh.Cells(i, 2))
p = Me.searchTextBox.TextLength
For k = 2 To .ColumnCount - 4

If LCase(Mid(sh.Cells(i, k), x, p)) = Me.searchTextBox And Me.searchTextBox <> "" Then
     .AddItem
     .List(.ListCount - 1, 0) = sh.Cells(i, 1).Value
     .List(.ListCount - 1, 1) = sh.Cells(i, 2).Value
     .List(.ListCount - 1, 2) = sh.Cells(i, 3).Value
     .List(.ListCount - 1, 3) = sh.Cells(i, 4).Value
     .List(.ListCount - 1, 4) = sh.Cells(i, 5).Value
     .List(.ListCount - 1, 5) = sh.Cells(i, 6).Value
     .List(.ListCount - 1, 6) = sh.Cells(i, 7).Value
     .List(.ListCount - 1, 7) = sh.Cells(i, 8).Value
     .List(.ListCount - 1, 8) = sh.Cells(i, 9).Value
     .List(.ListCount - 1, 9) = sh.Cells(i, 10).Value
     .List(.ListCount - 1, 10) = sh.Cells(i, 11).Value
     .List(.ListCount - 1, 11) = sh.Cells(i, 12).Value
End If
Next k
Next x
Next i
RemoveDuplicates Listbox1
End With
End Sub

Sub RemoveDuplicates(aListBox As MSForms.ListBox)
Dim i As Long, j As Long
With aListBox
For i = .ListCount - 1 To 1 Step -1
For j = 0 To i - 1
If (.List(i, 0) = .List(j, 0)) Or (.List(i, 0) = vbNullString) Then
     .RemoveItem i
Exit For
End If
Next j
Next i
End With
End Sub

问题原因 #

1. 搜索时向ListBox布尔列赋值时，直接使用单元格原始值（可能是数字1/0或字符串"True"/"False"），未转换为Boolean类型，导致双击填充CheckBox后未触发CheckBox1_Change事件更新颜色。
2. 原搜索逻辑嵌套多层循环，会重复添加同一行数据，去重效率低；且ColumnWidths参数存在语法错误。

解决方案及优化代码 #

1. 优化搜索功能代码（修复布尔值+高效去重） #

Private Sub searchButton_Click()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("TABLE")
    Dim i As Long, k As Integer
    Dim searchTxt As String
    Dim existingIDs As Collection
    
    Set existingIDs = New Collection
    searchTxt = LCase(Me.searchTextBox.Value)
    
    If searchTxt = "" Then
        Call All_Data
        Exit Sub
    End If
    
    With Me.ListBox1
        .Clear
        .ColumnHeads = False
        .ColumnCount = 12
        .ColumnWidths = "0,70,60,60,0,0,0,0,0,0,120,0" ' 修复语法错误
        
        For i = 2 To sh.Range("A" & Rows.Count).End(xlUp).Row
            ' 用Collection的Key唯一性提前去重
            On Error Resume Next
            existingIDs.Add sh.Cells(i, 1).Value, Key:=CStr(sh.Cells(i, 1).Value)
            On Error GoTo 0
            
            If Err.Number = 0 Then
                ' 模糊匹配指定列，简化搜索逻辑
                For k = 2 To 8
                    If LCase(sh.Cells(i, k).Value) Like "*" & searchTxt & "*" Then
                        .AddItem
                        ' 布尔列强制转换为Boolean类型
                        .List(.ListCount - 1, 0) = sh.Cells(i, 1).Value
                        .List(.ListCount - 1, 1) = sh.Cells(i, 2).Value
                        .List(.ListCount - 1, 2) = sh.Cells(i, 3).Value
                        .List(.ListCount - 1, 3) = sh.Cells(i, 4).Value
                        .List(.ListCount - 1, 4) = sh.Cells(i, 5).Value
                        .List(.ListCount - 1, 5) = sh.Cells(i, 6).Value
                        .List(.ListCount - 1, 6) = sh.Cells(i, 7).Value
                        .List(.ListCount - 1, 7) = sh.Cells(i, 8).Value
                        .List(.ListCount - 1, 8) = CBool(sh.Cells(i, 9).Value)
                        .List(.ListCount - 1, 9) = CBool(sh.Cells(i, 10).Value)
                        .List(.ListCount - 1, 10) = CBool(sh.Cells(i, 11).Value)
                        .List(.ListCount - 1, 11) = CBool(sh.Cells(i, 12).Value)
                        Exit For
                    End If
                Next k
            End If
        Next i
    End With
End Sub

2. 修改双击事件代码（触发颜色更新） #

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
    Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
    Me.TextBox3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
    Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
    Me.TextBox5.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
    Me.TextBox6.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)
    Me.TextBox7.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)
    Me.ComboBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7)
    Me.CheckBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8)
    Me.CheckBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)
    Me.CheckBox3.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 10)
    Me.CheckBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 11)
    
    ' 手动触发CheckBox1颜色更新
    Call CheckBox1_Change
End Sub

3. 优化All_Data代码（修复Range引用） #

Sub All_Data()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("TABLE")
    Dim last_Row As Long
    last_Row = sh.Range("A:A").End(xlUp).Row ' 替换CountA，避免空行问题
    
    With Me.ListBox1
         .ColumnHeads = False
         .ColumnCount = 12
         .ColumnWidths = "0,70,60,60,0,0,0,0,0,0,120,0"
         .List = sh.Range(sh.Cells(1, 1), sh.Cells(last_Row, .ColumnCount)).Value
         .RemoveItem 0    
    End With
End Sub

4. 移除原RemoveDuplicates过程 #

优化后的搜索代码通过Collection提前去重，无需事后删除重复项。

关键修复说明 #

• 布尔值转换：用CBool()将单元格值强制转为Boolean类型，确保ListBox存储正确的布尔状态。
• 提前去重：利用Collection的Key唯一性，避免重复添加数据，提升效率。
• 搜索逻辑简化：用Like实现模糊匹配，替代多层嵌套的Mid循环。
• 手动触发事件：双击填充后调用CheckBox1_Change，确保颜色同步。
• 修复Range引用：明确指定工作表对象，避免跨表错误。

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