Excel 下拉框是不是可以作为带有多选复选框的列表框？

Posted 2023-02-24

技术标签:

【中文标题】Excel 下拉框是不是可以作为带有多选复选框的列表框？【英文标题】：Could an Excel dropdown box behave as a ListBox with checkboxes for Multi Selection?Excel 下拉框是否可以作为带有多选复选框的列表框？ 【发布时间】：2021-05-13 17:10:31 【问题描述】：

我有一个用于输入产品数据的 Excel 工作表。每个单独的产品使用 16 行。单元格包含公式、从另一个工作簿验证的下拉框和用于多项选择的列表框，例如颜色。

我需要复制这 16 行以用作新产品的模板，并将其粘贴到前一行下方，对每个新产品重复此操作。

下拉框在单元格级别可以很好地复制下来，并允许每个新产品都有自己的下拉框选择。

问题在于复制/粘贴 ListBox。由于它们没有连接到单元格，并成为具有新名称的副本，因此用于打开/关闭它们并将选择输出到单元格的代码不再起作用。即使它们保持相同的名称，它们也只会与第一个产品相关，并且不允许为每个新产品输入单独的数据。

这是用于控制列表框的代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A$2" And .Visible = False Then
            .Visible = True
            Application.EnableEvents = False
            [A3].Select
            Application.EnableEvents = True
        Else
            .Visible = False
            For I = 0 To .ListCount - 1
                If .Selected(I) Then txt = txt & ", " & .List(I)
            Next
            [A2] = Mid(txt, 2)  'remove first comma and output to A2 cell
        End If
    End With
End Sub

ListBoxes 似乎是一个很好的多选解决方案，同时完善了 1 个虚拟产品的电子表格，但是我看不出它们如何在这个应用程序中为每个新产品工作。有没有其他方法可以实现这一目标？下拉框是否可以像 ListBox 一样更改为具有多个选择的复选框？

我已经看到按照此处显示的方法用于多项选择的保管箱：

How to Make Multiple Selections in a Drop Down List in Excel

但是，除了查看逗号分隔列表中的输出外，无法查看选择了哪些项目，这可能会变成很长的列表。选择需要通过复选框在列表本身中可见。

任何建议将不胜感激。

【问题讨论】：

这只是一个没有说什么的故事，恐怕......请编辑您的问题并发布看起来有问题的代码片段。相关工作表的一些图片也应该有所帮助。根据上面的故事，你会得到什么样的答案？那么，如果 List Boxes 解决方案看起来很棒（对您而言），为什么不使用此类列表框更改 DropDown 对象？您的 16 行产品部分中的列表框具有与该 16 行部分中的单元格相关联的选项，对吗？然后当您复制该部分（和列表框）时，列表框仍然链接回原始部分，而不是新产品部分？您是使用代码创建新产品部分还是手动复制？ @PeterT 此时我正在手动复制/粘贴行。列表框 1 和 2 lare 链接到原始部分，但它们作为列表框 3 和 4 复制到新部分，并且不再有任何与它们相关的 vba。即使他们可以保持相同的名称，他们也不会为每个产品独立工作。我已编辑问题以显示示例。 @FaneDuru 我已编辑问题以显示示例。下拉框很好，因为它们对于单个选择（例如类别）很简单，并且不需要代码即可工作。它们可以被复制和粘贴并独立运行。列表框很好，因为它们允许多项选择（例如颜色），但是需要代码以对我有用的方式工作，并且似乎无法为我希望添加的每个新产品复制/粘贴。 【参考方案1】：

我提出的解决方案确实在一定程度上改变了列表框的外观。您正在使用一个 ActiveX 列表框，它为您的多选提供了漂亮的复选框。我遇到的问题是将宏分配给列表框以捕获OnAction 事件（每次单击列表框项时）。我下面的解决方案适用于表单列表框。解决方案有几个部分。

您提出了一项要求，即当用户在“颜色”列中选择一个单元格时，会弹出一个列表框并显示颜色选项列表。为此，我在工作表模块中使用了Worksheet_SelectionChange 事件：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Dim colourRange As Range
    Set colourRange = ColourArea(ActiveSheet)
    If colourRange Is Nothing Then Exit Sub
    If Not Intersect(Target, colourRange) Is Nothing Then
        CreateColourPopUp Target
    Else
        DeleteAllPopUps Target
    End If
End Sub

这里需要注意的重要一点是，只要用户在“颜色”列中选择一个单元格，就会创建弹出窗口，并且只要选择了超出该范围的单元格，就会删除弹出窗口。 ColourArea 是在一个单独的模块中定义的（所有其他代码都在这个答案Module1 中）：

Public Function ColourArea(ByRef ws As Worksheet) As Range
    '--- returns a range for the colour selections for all the products
    '    currently active on the worksheet
    Const COLOUR_COL As Long = 6
    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        Set ColourArea = .Cells(2, COLOUR_COL).Resize(lastRow, 1)
    End With
End Function

我将其与Worksheet_SelectionChange 分开编码，因为您现在或将来可能会使用其他方式来确定工作表上的哪个范围用于您的颜色。

然后在此处的代码中创建弹出窗口，其中列表框是在所选单元格正下方的单元格中创建的。再次注意，确定包含颜色列表的范围是封装在一个函数中的。

Public Function ColourListArea() As Range
    Set ColourListArea = Sheet1.Range("M1:M11")
End Function

Public Sub DeleteAllPopUps(ByRef selectedCell As Range)
    Dim colourBox As ListBox
    For Each colourBox In selectedCell.Parent.ListBoxes
        colourBox.Delete
    Next colourBox
End Sub

Public Sub CreateColourPopUp(ByRef selectedCell As Range)
    Set colourSelectCell = selectedCell
    
    Dim popUpCell As Range
    Set popUpCell = colourSelectCell.OFFSET(1, 0)
    
    DeleteAllPopUps selectedCell

    '--- now create the one we need, right below the selected cell
    Const POPUP_WIDTH As Double = 75
    Const POPUP_HEIGHT As Double = 110
    Const OFFSET As Double = 5#
    Dim colourBox As ListBox
    Set colourBox = ActiveSheet.ListBoxes.Add(popUpCell.left + OFFSET, _
                                              popUpCell.top + OFFSET, _
                                              POPUP_WIDTH, _
                                              POPUP_HEIGHT)
    With colourBox
        .ListFillRange = ColourListArea().Address
        .LinkedCell = ""
        .MultiSelect = xlSimple
        .Display3DShading = True
        .OnAction = "Module1.ColourBoxClick"
    End With
    
    '--- is there an existing list of colours selected?
    Dim selectedColours() As String
    selectedColours = Split(colourSelectCell.Value, ",")
    Dim colour As Variant
    For Each colour In selectedColours
        Dim i As Long
        For i = 1 To colourBox.ListCount
            If colourBox.List(i) = colour Then
                colourBox.Selected(i) = True
                Exit For
            End If
        Next i
    Next colour
End Sub

变量colourSelectCell 在模块全局级别声明（请参阅本文末尾的完整模块）。您可能需要根据需要手动调整宽度和高度常量。

最后，OnAction 例程定义为：

Public Sub ColourBoxClick()
    Dim colourBoxName As String
    colourBoxName = Application.Caller
    
    Dim colourBox As ListBox
    Set colourBox = ActiveSheet.ListBoxes(colourBoxName)

    Dim colourList As String
    Dim i As Long
    For i = 1 To colourBox.ListCount
        If colourBox.Selected(i) Then
            colourList = colourList & colourBox.List(i) & ","
        End If
    Next i
    If Len(colourList) > 0 Then
        colourList = Left$(colourList, Len(colourList) - 1)
    End If
    colourSelectCell.Value = colourList
End Sub

这是使用全局colourSelectCell 的地方。

整个Module1是

Option Explicit

Private colourSelectCell As Range

Public Function ColourArea(ByRef ws As Worksheet) As Range
    Const COLOUR_COL As Long = 6
    '--- returns a range for the colour selections for all the products
    '    currently active on the worksheet
    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        If lastRow = 0 Then
            Set ColourArea = Nothing
        Else
            Set ColourArea = .Cells(2, COLOUR_COL).Resize(lastRow, 1)
    End With
End Function

Public Sub ColourBoxClick()
    Dim colourBoxName As String
    colourBoxName = Application.Caller
    
    Dim colourBox As ListBox
    Set colourBox = ActiveSheet.ListBoxes(colourBoxName)

    Dim colourList As String
    Dim i As Long
    For i = 1 To colourBox.ListCount
        If colourBox.Selected(i) Then
            colourList = colourList & colourBox.List(i) & ","
        End If
    Next i
    If Len(colourList) > 0 Then
        colourList = Left$(colourList, Len(colourList) - 1)
    End If
    colourSelectCell.Value = colourList
End Sub

Public Function ColourListArea() As Range
    Set ColourListArea = Sheet1.Range("M1:M11")
End Function

Public Sub DeleteAllPopUps(ByRef selectedCell As Range)
    Dim colourBox As ListBox
    For Each colourBox In selectedCell.Parent.ListBoxes
        colourBox.Delete
    Next colourBox
End Sub

Public Sub CreateColourPopUp(ByRef selectedCell As Range)
    Set colourSelectCell = selectedCell
    
    Dim popUpCell As Range
    Set popUpCell = colourSelectCell.OFFSET(1, 0)
    
    DeleteAllPopUps selectedCell

    '--- now create the one we need, right below the selected cell
    Const POPUP_WIDTH As Double = 75
    Const POPUP_HEIGHT As Double = 110
    Const OFFSET As Double = 5#
    Dim colourBox As ListBox
    Set colourBox = ActiveSheet.ListBoxes.Add(popUpCell.left + OFFSET, _
                                              popUpCell.top + OFFSET, _
                                              POPUP_WIDTH, _
                                              POPUP_HEIGHT)
    With colourBox
        .ListFillRange = ColourListArea().Address
        .LinkedCell = ""
        .MultiSelect = xlSimple
        .Display3DShading = True
        .OnAction = "Module1.ColourBoxClick"
    End With
    
    '--- is there an existing list of colours selected?
    Dim selectedColours() As String
    selectedColours = Split(colourSelectCell.Value, ",")
    Dim colour As Variant
    For Each colour In selectedColours
        Dim i As Long
        For i = 1 To colourBox.ListCount
            If colourBox.List(i) = colour Then
                colourBox.Selected(i) = True
                Exit For
            End If
        Next i
    Next colour
End Sub

编辑：这是一个返回不连续单元格范围的示例允许弹出窗口。 ALSO -- 将If Target.Cells.Count > 1 Then Exit Sub 行添加到Worksheet_SelectionChange 子中，这样您在选择多个单元格时就不会出错。

Public Function ColourArea(ByRef ws As Worksheet) As Range
    Const COLOUR_COL As Long = 6
    Const PRODUCT_ROWS As Long = 16
    '--- returns a range for the colour selections for all the products
    '    currently active on the worksheet
    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lastRow = 0 Then
            ColourArea = Nothing
        Else
            Dim numberOfProducts As Long
            numberOfProducts = (lastRow - 1) / PRODUCT_ROWS
        
            '--- now create a Union of the first row of each of these
            '    product areas
            Dim firstRow As Range
            Dim allFirsts As Range
            Set firstRow = ws.Cells(2, COLOUR_COL)
            Set allFirsts = firstRow
        
            Dim i As Long
            For i = 2 To numberOfProducts
                Set firstRow = firstRow.OFFSET(PRODUCT_ROWS, 0)
                Set allFirsts = Application.Union(allFirsts, firstRow)
            Next i
            Set ColourArea = allFirsts
        End If
    End With
End Function

【讨论】：

谢谢。我无法让它工作。我仅将 Private Sub 放置在 Worksheet Selection Change 中，并将所有其他内容放置在一个模块中。我有点困惑，并尝试创建一个表单列表框并将宏从模块分配给它，并分配一个链接单元格，然后删除列表框并假设它是由代码本身创建的。它在我的头上！我收到运行时错误 1004，突出显示的代码行是 Set ColourArea = .Cells(2, COLOUR_COL).Resize(lastRow, 1) @ayecee - 您根本不必手动创建列表框，示例代码会为您创建它。至于错误，我的猜测是lastRow 将为零，因此您应该更改该例程确定实际区域的方式（F 列？第 2-16 行？）。该函数仅用于确定用户必须为产品选择颜色的单元格范围。 Set ColourListArea = Sheet1.Range("M1:M11") 这将是颜色验证列表的范围是否正确？ @ayecee - 来自您的数据原始图像，是的。这是我在自己的工作表上设置的示例。谢谢我现在有这个工作。我遇到的唯一问题是单击每一行时显示的颜色列表。如何将其修改为仅显示在 16 行组的第一行？这可以是任意数量的行，16 只是一个示例。

以上是关于Excel 下拉框是不是可以作为带有多选复选框的列表框？的主要内容，如果未能解决你的问题，请参考以下文章

多选组合框 - 必填项

使用带复选框的多选下拉菜单搜索或过滤 jquery 数据表中的列

Codeigniter：如何使用 jQuery 添加带有多选和删除复选框的列

设置多选选择框的高度

html中怎样实现具有下拉效果的多选框

html如何做下拉的可多选的复选框列表