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

Question

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

我遇到的问题是K列中的每个单元格需要不同，例如，如果我的下载列表是＆＃34;项目A，项目B，项目C＆＃34;然后在K3中检查项目A，然后它应该只显示项目A.但是，如果我点击K29并选择项目A，B和C，那么它应该显示＆＃34;项目A，项目B，项目C＆＃34;在那个牢房里。

这是我测试的一个例子，它没有工作，因为它用我检查的内容填充了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
• Autosize = true
• Wordwrap = false

我添加了Listbox并更改了其属性，如下所示：

• Name = lboxItems
• MultiSelect = 1 - fmMultiSelectMulti
• ListStyle = 1 - fmListStyleOption
• 列表项= Sheet2！A1：A7~＆gt;使用你自己物品的范围。

我添加了2 CommandButtons并将其命名为btnOk和btnCanx（并将其标题更改为'确定'和'取消'。

然后在Userform的代码中，我使用了：

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