VBA Excel - 使用 AddItem 时将标题添加到组合框

Question

我有一个列表，其中包含我想在我的用户表单中添加到组合框中的值。

我想要的值在 A 列和 Z 列中（所以值来自 2 列）。我设法使用 AddItem 函数添加值，但努力向下拉列表添加标题（一些帖子说这是不可能的）。

作为替代方案，我看到了 ListFillRange，但我不知道这是否可以用于两个不相邻的列。 感谢您的帮助。

Answer 1

a few posts said this is not possible

我通常不会回答没有任何努力的问题，但这是一个有趣的问题。我倾向于同意你的观点，很多人认为你不能在 ComboBox 中显示标题。

但可以在Combobox 中显示标题。这是一个演示。如果您不想想要更改原始工作表，您当然需要借助辅助工作表。

测试用例

对于我们的演示，我们将采用 2 个非连续范围 A1-A5 和 D1-A5

逻辑

1. 您将相关数据复制到新工作表中。
2. 将范围转换为表格
3. 将组合框的列标题设置为 true
4. 将行源设置为帮助表中的相关表格范围。

代码

Option Explicit

Dim ws As Worksheet

Private Sub UserForm_Initialize()
    Dim wsInput As Worksheet
    
    '~~> Input sheet. Change as applicable
    Set wsInput = Sheet1
    
    '~~> Add a new sheet. Hide it (Optional)
    Set ws = ThisWorkbook.Sheets.Add
    ws.Visible = xlSheetHidden
    
    '~~> Copy the non-contigous range to the new sheet
    wsInput.Range("A1:A5").Copy ws.Range("A1")
    wsInput.Range("D1:D5").Copy ws.Range("B1")
    
    Dim rng As Range
    
    '~~> Get your range
    Set rng = ws.Range("A1:B5")
    
    '~~> Convert range to table
    ws.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "MyTable"
    
    '~~> Few combobox settings and we are done
    With ComboBox1
        .ColumnCount = 2
        .ColumnHeads = True
        .RowSource = "MyTable"
    End With
End Sub

'~~> Delete the temp sheet we created
Private Sub UserForm_Terminate()
    Application.DisplayAlerts = False
    If Not ws Is Nothing Then ws.Delete
    Application.DisplayAlerts = True
End Sub

输出

替代

如果您对辅助表的想法不满意并且可以牺牲标题部分，那么您可以使用非连续范围填充组合框。见Excel VBA Multicolumn Listbox add non contiguous range。您当然必须编辑代码以满足您的需要。由于只有两列，您的最终数组看起来像Dim Ar(1 To LastRow, 1 To 2)。该数组将保存两列的值。

Answer 2

我使用以下代码在列表框和组合框上方添加标题。敲碎螺母看起来有点像大锤，但有时必须敲碎螺母，而我看到的所有其他方法和工具也都属于大锤的范畴。

为了让我自己尽可能简单，我定义了一个名为 clsListBoxHeaders 的类，并在下面包含了该代码。然后假设您有一个包含 3 列的 ListBox，您需要

1. 告诉班级要处理哪个 ListBox
2. 告诉它标题是什么
3. 告诉它列宽

为此，在您的用户表单中插入以下代码

Dim lbHeaders As New clsListBoxHeaders
    Set lbHeaders.ListBox = ListBox1
    lbHeaders.Headers = "First Header;Second Header;Third Header"
    lbHeaders.ColumnWidths = "40;50;60"

请注意，标题的数量和列宽的数量必须与列表框/组合框中的列数完全匹配

要清除标题数据，请使用：

lbHeaders.Clear

如果您想格式化标签（例如字体），那么您可以将标签作为变量数组访问

lbHeaders.Labels

类模块代码如下：

Option Explicit

' clsListBoxHeaders - Display header info above a ListBox or ComboBox

' To use this class in your project:
'   Add a class module called clsListBoxHeaders and paste this code into it
'   For each ListBox or ComboBox for which you wish to display column headers insert the following code in your userform:

'   Dim lbHeaders As New clsListBoxHeaders
'    Set lbHeaders.ListBox = ListBox1
'    lbHeaders.Headers = "First Header;Second Header;Third Header"
'    lbHeaders.ColumnWidths = "40;50;60"

'Note that the number of headers and the number of columnwidths must match exactly the number of columns in your listbox/combobox

' To clear the header data use:
'   lbHeaders.Clear


Const LabelHeight As Integer = 10   ' Height of the header labels.
Const LabelOffset As Integer = 10   ' Offset to get the header to align correctly to first column in listbox

Private myListBox As Object
Private myParent As Object
Private lblHeaders() As MSForms.Label
Private sColumnWidths() As Single

Public Property Set ListBox(ListBox As Object)
    Set myListBox = ListBox
    Set myParent = ListBox.Parent
End Property

Public Property Let Headers(sHeaders As String)
    Dim lLeft As Long, vHeaders As Variant
    Dim iCol As Integer
    With myListBox
    vHeaders = Split(sHeaders, ";")
    ReDim lblHeaders(.ColumnCount)
    If UBound(sColumnWidths) = 0 Then
        ReDim sColumnWidths(.ColumnCount)
        For iCol = 1 To .ColumnCount
            sColumnWidths(iCol) = .Width / .ColumnCount
        Next
    End If
    lLeft = LabelOffset
    For iCol = 1 To .ColumnCount
        Set lblHeaders(iCol) = myParent.Controls.Add("Forms.Label.1")
        With lblHeaders(iCol)
            .Top = myListBox.Top - LabelHeight
            .Left = lLeft + myListBox.Left
            .Width = sColumnWidths(iCol)
            .Height = LabelHeight
            lLeft = lLeft + sColumnWidths(iCol)
            .Visible = True
            .Caption = vHeaders(iCol - 1)
            .ZOrder fmZOrderFront
        End With
    Next
    End With
End Property

Public Property Let ColumnWidths(ColumnWidths As String)
    Dim vSplit As Variant
    Dim lLeft As Long
    Dim iCol As Integer
    With myListBox
    vSplit = Split(ColumnWidths, ";")
    ReDim sColumnWidths(.ColumnCount)
    For iCol = 1 To .ColumnCount
        sColumnWidths(iCol) = vSplit(iCol - 1)
    Next
    lLeft = LabelOffset
    If UBound(lblHeaders) > 0 Then
        For iCol = 1 To .ColumnCount
            With lblHeaders(iCol)
                .Left = myListBox.Left + lLeft
                .Width = sColumnWidths(iCol)
                lLeft = lLeft + sColumnWidths(iCol) ' + LabelOffset
            End With
        Next
    End If
    End With
End Property

Public Property Get Labels() As Variant
    Dim iCol As Integer
    Dim vLabels As Variant
    
    With myListBox
    ReDim vLabels(.ColumnCount - 1)
    For iCol = 1 To .ColumnCount
        Set vLabels(iCol - 1) = lblHeaders(iCol)
    Next
    End With
    Labels = vLabels
End Property

Public Sub Clear()
    Dim i As Integer
    For i = 1 To UBound(lblHeaders)
        myParent.Controls.Remove lblHeaders(i).Name
    Next
    Class_Initialize
End Sub

Private Sub Class_Initialize()
    ReDim lblHeaders(0)
    ReDim sColumnWidths(0)
End Sub