多个单元格的下拉列表中的多个复选框

Question

我有一个标题为“下载”的 K 列。我希望能够单击 K 列中的一个单元格，然后出现一个带有复选框的列表框，我从 7 个列表（存储在另一张表中）中选择该用户已下载的文件的名称。然后将它们添加到单元格中，用逗号分隔。

我遇到的问题是 K 列中的每个单元格都需要不同，例如，如果我的下载列表是“项目 A、项目 B、项目 C”等，然后在 K3 中检查项目A，那么它应该只显示项目 A。但是，如果我单击 K29 并选择项目 A、B 和 C，那么它应该在该单元格中显示“项目 A、项目 B、项目 C”。

这是我正在测试的一个示例，它不起作用，因为它用我检查的内容填充了 K 列中的每个单元格。此外，下拉菜单始终可见，我只希望它在单击单元格时可见：

Private Sub ListBox1_Change()

Dim lngCurrentItem As Long
Dim strCurrentItem As String
Dim strAllSelectedItems As String
Dim rngOutput As Range

Set rngOutput = [K1:K999]

strAllSelectedItems = ""

For i = 0 To ListBox1.ListCount - 1
    strCurrentItem = ListBox1.List(i)

If ListBox1.Selected(i) Then
    If strAllSelectedItems = "" Then
        strAllSelectedItems = strCurrentItem
    Else
        strAllSelectedItems = strAllSelectedItems & " - " & strCurrentItem
    End If
End If

Next i

If strAllSelectedItems = "" Then
rngOutput = "No Items Selected"
ElseIf InStr(1, strAllSelectedItems, " - ", vbTextCompare) > 0 Then
rngOutput = strAllSelectedItems & " Are Selected"
Else
    rngOutput = strAllSelectedItems & " Is Selected"
End If

End Sub

Answer 1

如果我这样做，我想我会使用Userform。

你可以在你的编辑器中插入一个，让它看起来像这样：

我添加了一个Label 并将其属性更改如下：

• 名称 = lblPrompt
• 自动调整大小 = true
• 自动换行 = 假

我添加了一个Listbox，并将其属性更改如下：

• 名称 = lboxItems
• MultiSelect = 1 - fmMultiSelectMulti
• ListStyle = 1 - fmListStyleOption
• List item = Sheet2!A1:A7 ~> 使用您自己的项目范围。

我添加了 2 个CommandButtons 并将它们命名为 btnOk 和 btnCanx（并将它们的标题更改为“确定”和“取消”。

然后在用户窗体的代码中，我使用了：

Option Explicit
Private mCell As Range
Public Sub PopUp(user As String, cell As Range)
    Dim i As Integer

    Set mCell = cell
    lblPrompt = "Downloads by " & user
    For i = 0 To lboxItems.ListCount - 1
        lboxItems.Selected(i) = False
    Next
    Me.Show
End Sub

Private Sub btnCanx_Click()
    Me.Hide
End Sub

Private Sub btnOk_Click()
    Dim i As Integer
    Dim itemText As String

    For i = 0 To lboxItems.ListCount - 1
        If lboxItems.Selected(i) Then
            If Len(itemText) > 0 Then
                itemText = itemText & ", "
            End If
            itemText = itemText & lboxItems.List(i)
        End If
    Next

    mCell.Value = itemText

    Me.Hide

End Sub

最后，在Worksheet 后面的代码上。我放了：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cell As Range
    Dim user As String

    For Each cell In Target.Cells
        If Not Intersect(cell, Columns("K")) Is Nothing Then
            user = CStr(cell.Offset(, -10).Value2)
            UserForm1.PopUp user, cell
        End If
    Next
End Sub