简体   繁体   English

VBA Excel - 添加 header 到 ZA8284521647549D6ECZB00383A3C2BDItem 时

[英]VBA Excel - add header to combobox when using AddItem

I have a list with values I like to add to combobox in my userform.我有一个列表,其中包含我想在我的用户表单中添加到 combobox 的值。

The values I want are in Column A and Column Z (so values from 2 columns).我想要的值在 A 列和 Z 列中(所以值来自 2 列)。 I manage to add the values with the AddItem function but struggling to add a header to the dropdown (a few posts said this is not possible).我设法使用 AddItem function 添加值,但努力将 header 添加到下拉列表中(一些帖子说这是不可能的)。

As alternative I saw ListFillRange but I cannot figure out if this can be used for two columns which are not next to each other.作为替代方案,我看到了 ListFillRange,但我不知道这是否可以用于两个不相邻的列。 Appreciate the help.感谢帮助。

a few posts said this is not possible

I usually do not reply to questions which do not show any efforts but this is an interesting one.我通常不会回答没有任何努力的问题,但这是一个有趣的问题。 I tend to agree with you that lot of people think that you cannot show headers in a ComboBox .我倾向于同意你的观点,很多人认为你不能ComboBox中显示标题。

But it is possible to show headers in a Combobox .但是可以Combobox中显示标题。 Here is a demonstration.这是一个演示。 You will of course have to take help of a helper sheet for this if you do not want to change the original sheet.如果您不想更改原始工作表,您当然必须为此使用辅助工作表。

TEST CASE测试用例

For our demonstration, we will take 2 non-contigous range A1-A5 and D1-A5对于我们的演示,我们将采用 2 个非连续范围A1-A5D1-A5

在此处输入图像描述

LOGIC逻辑

  1. You will copy the relevant data to a new sheet.您将相关数据复制到新工作表中。
  2. Convert the range to a table将范围转换为表格
  3. Set columnheads to true of combobox将 combobox 的列标题设置为 true
  4. Set rowsource to the relevant table range from helper sheet.将行源设置为帮助表中的相关表范围。

CODE代码

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

OUTPUT OUTPUT

在此处输入图像描述

ALTERNATIVE选择

If you are not ok with the idea of helper sheet and are ok to sacrifice on the header part then you can populate a combobox using non contigous ranges.如果您对辅助表的想法不满意并且可以牺牲 header 部分,那么您可以使用非连续范围填充 combobox。 See Excel VBA Multicolumn Listbox add non contiguous range .请参阅Excel VBA 多列列表框添加非连续范围 You will of course have to edit the code to suit your needs.您当然必须编辑代码以满足您的需要。 Since there are two columns only, your final array would look like Dim Ar(1 To LastRow, 1 To 2) .由于只有两列,您的最终数组看起来像Dim Ar(1 To LastRow, 1 To 2) This array will hold values from both columns.该数组将保存两列的值。

I use the following code to add headers above listboxes and comboboxes.我使用以下代码在列表框和组合框上方添加标题。 It seems a bit like a sledgehammer to crack a nut but sometimes the nut has to be cracked, and all the other methods and tools that I have seen also fall into the category of sledgehammer.敲碎螺母看起来有点像大锤,但有时必须敲碎螺母,而我看到的所有其他方法和工具也属于大锤的范畴。

To make this as simple as possible for myself I have defined a class called clsListBoxHeaders and I include that code below.为了使这对我自己来说尽可能简单,我定义了一个名为 clsListBoxHeaders 的 class,并在下面包含了该代码。 Then suppose you have a ListBox with 3 columns you need to然后假设您有一个包含 3 列的 ListBox,您需要

  1. Tell the class which ListBox it is to work on告诉 class 它在哪个 ListBox 上工作
  2. Tell it what the headers are告诉它标题是什么
  3. Tell it the column widths告诉它列宽

To do this insert the following code in your user form为此,在您的用户表单中插入以下代码

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:要清除 header 数据,请使用:

lbHeaders.Clear

If you want to format the labels (eg font) then you can access the labels as a variant array如果要格式化标签(例如字体),则可以将标签作为变量数组访问

lbHeaders.Labels

The class module code is as follows: class模块代码如下:

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM