如何实现下拉菜单同时多选（修正即可）

arilla

大家好：如题（可见附件）
以下是已经根据网站老师给出的代码修正过了的（代码是在K列进行复选框，在sheet2中有数据A列与B列数据相同即可
），但还需要做修正：
1. 因为我的复选内容很规律，可否删除sheet2的数据源，直接编辑在代码中（如：你，我，她，他，他们，它，她们）
2. 此代码复选后单元格显示内容为竖直排列，可否更改为并排以逗号分开
3. 此代码复选后以回车键结束复选，可否更改为点击鼠标左键至空白处，即可结束
十分感谢！

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim t%
    If KeyCode = 13 Then       '回车
        If ListBox1.ListCount > 0 Then
            For i = 0 To ListBox1.ListCount - 1
                If ListBox1.Selected(i) Then
                    aa = aa & ListBox1.List(i) & vbCrLf
                End If
            Next
            ActiveCell = aa
            Me.ListBox1.Clear
            Me.ListBox1.Visible = False
            KeyCode = 0
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then ListBox1.Visible = False: Exit Sub
If Target.Row < 2 Then ListBox1.Visible = False: Exit Sub
If Target.Column <> 11 Then ListBox1.Visible = False: Exit Sub
Dim n%, Arr, d, d1, i&, k, k1
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Arr = Sheet3.UsedRange
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> "" Then d(Arr(i, 1)) = Arr(i, 2)
    Next
k = d.keys: k1 = d1.keys
With ListBox1
    .Visible = True
    .Clear
    .Left = Target.Left + 80
    .Top = Target.Top
    .Height = Target.Height * 8
    .Width = Target.Width + 45

End With
If Target.Column = 11 Then
    For n = 0 To UBound(k)
     ListBox1.AddItem k(n)


    Next

End If
End Sub



再次感谢！

我是来讨说法的

唉
aa = aa & ListBox1.List(i) & vbCrLf
vbCrLf表示回车换行，你把这个换成你想要的逗号不就行了

arilla

我是来讨说法的 发表于 2018-8-9 11:24
唉
aa = aa & ListBox1.List(i) & vbCrLf
vbCrLf表示回车换行，你把这个换成你想要的逗号不就行了

感谢，能告知如何实现鼠标左单击来结束多选，替代回车吗？

arilla

已解决，感谢大家。