结合代码从excel下拉菜单选择多个选项

182197315

excel下拉菜单只能选择一个选项，本例可以实现选择多个选项。请指点。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" Then
        If xValue2 <> "" Then
            If xValue1 = xValue2 Or _
               InStr(1, xValue1, ", " & xValue2) Or _
               InStr(1, xValue1, xValue2 & ",") Then
                Target.Value = xValue1
            Else
                Target.Value = xValue1 & "," & xValue2
            End If
        End If
    End If
End If
Application.EnableEvents = True
End Sub

feng-aaaa

feng-aa@qq.com,感谢分享,请发我一份