如何在 VBA ListBox 中设置列​​ Header 和格式化列?

How to Set Column Header and Format Columns in VBA ListBox?

我有一个 userform,其中有一个 TextBox 和一个 ListBox.

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

一个数据sheet被命名为“DAY BOOK”,其中D列和H列是一个日期字段。

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

还需要:DAY BOOK sheet 的第一列为空。

如有任何帮助,我们将不胜感激。

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,50,60,60,50,50,0,0,60,60,60,0,60,60,40,35,60,45,60,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) To UBound(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

获取列 header 和日期格式

1."... then headerline disappears"

假设有 no RowSource 绑定,因为这不会与以后在您的 post 中执行的动态数组分配合作,这就足够了在代码行 Set rowList = New Collection 之后立即插入 rowList.Add 1 以包含标题,因为它将作为第一个元素添加到 collection(指的是 header 第 1 行)。

2."... and date fields [columns D and H] are shown in numbers"

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

如果仅用于搜索问题,您可以将部分注释 'Read the values into an array. 后的代码行更改为 v = rng.Value(而不是 .Value2),以根据区域设置显示日期格式,否则在填充列表框之前,您必须分别通过数组 v 和过滤后的数组 listItems 循环来更改每种格式。

3."(the) first column (is displayed) empty"

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

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

进一步提示:将变量命名为 removeItem 如果它用于包含项似乎适得其反。