如何在 VBA ListBox 中设置列​​标题和格式列？

如何解决如何在 VBA ListBox 中设置列​​标题和格式列？

我有一个用户表单，其中包含一个 TextBox 和一个 ListBox。

TextBox1 用于类型查询，ListBox1 用于搜索结果。

数据表名为“DAY BOOK”，其中 D 列和 H 列是日期字段。

下面的代码运行良好，但显示搜索结果

• 标题消失并且
• 日期字段在搜索前后显示为数字（如何格式化日期列）

还需要：DAY BOOK表的第一列为空。

作为新手，任何帮助将不胜感激。

Private Const LISTBOX_COL_COUNT As Long = 12
'Option Explicit
'Public EnableEvents As Boolean
Public iWidth As Integer
Public iHeight As Integer
Public iLeft As Integer
Public iTop As Integer
Public bState As Boolean
Dim BlnVal As Boolean

Private Sub TextBox1_Change()
    PopulateListbox "*" & TextBox1.Text & "*"
End Sub

Private Sub userform_activate()
    With ListBox1
        .ColumnHeads = True
        .ColumnCount = LISTBOX_COL_COUNT
        '.ColumnWidths = "20,35,70,50,60,40,45,60"
    End With
    PopulateListbox
    TextBox1.SetFocus
End Sub

Private Sub PopulateListbox(Optional removeItem As String = vbNullString)
    Dim rng As Range
    Dim v() As Variant,listItems() As Variant
    Dim rowNum As Variant
    Dim rowList As Collection
    Dim r As Long,c As Long
    Dim itemText As String
    Dim isMatch As Boolean

    On Error GoTo pvs:

    'Define the target range.
    With Worksheets("DAY BOOK")
        Set rng = .Range(.Cells(1,1),.Cells(.Rows.Count,1).End(xlUp)).Resize(,LISTBOX_COL_COUNT)
    End With

    'Read the values into an array.
    v = rng.Value2

    'If no removals are required then just populate with the read array.
    If removeItem = vbNullString Then
        ListBox1.List = v
        Exit Sub
    End If

    'For removals find the list of matching rows in the array.
    Set rowList = New Collection
    For r = LBound(v,1) To UBound(v,1)
        isMatch = False
        For c = LBound(v,2) To UBound(v,2)
            itemText = LCase(CStr(v(r,c)))
            If itemText Like removeItem Then
                isMatch = True
                Exit For
            End If
        Next
        If isMatch Then rowList.Add r
    Next
    
    'Size the new list array,based on matching items.
    ReDim listItems(1 To rowList.Count,0 To LISTBOX_COL_COUNT)
    
    'Copy the matchings rows to the new array.
    r = 1
    For Each rowNum In rowList
        For c = LBound(v,2)
            listItems(r,c) = v(rowNum,c)
        Next
        r = r + 1
    Next
    
    'Populate the listbox with the new array.
    ListBox1.List = listItems

pvs:
TextBox1.SetFocus
End Sub

解决方法

获取列标题和日期格式

1.“...然后标题消失”

假设没有 RowSource 绑定，因为这不会与您的帖子中执行的后续动态数组分配配合，因此在代码后立即插入 rowList.Add 1 就足够了行 Set rowList = New Collection 包含标题，因为它将作为第一个元素添加到集合中（参考标题行 1）。

2.“...和日期字段 [D 列和 H 列] 以数字显示”

通过 .Value2 将范围值分配给数据字段数组会导致日期显示为数值，例如D 列中的 2021 年 1 月 4 日将显示为 44201。

如果仅用于搜索事项，您可以将部分注释后的代码行 'Read the values into an array. 更改为 v = rng.Value（而不是 .Value2），显示由于区域设置的日期格式，否则您在填充列表框之前，d 必须通过循环遍历数组 v 分别更改过滤后的数组 listItems 来更改每个格式。

3.“第一列（显示）为空”

如果不希望第一个列表框列为空，请将部分注释 'Size the new list array,based on matching items. 后的代码行更改为

ReDim listItems(1 To rowList.Count,1 To LISTBOX_COL_COUNT)

进一步提示：如果变量 removeItem 用于包含项目，则命名它似乎适得其反。