Excel VB脚本，下拉框多选

 

1.数据-数据验证，先做出单选效果

     在弹出的数据验证窗口选择   序列，然后选择下拉的数据来源

2.开发者工具-VisualBasic 

     在打开的窗口里面，选择需要下拉的sheet页，然后双击sheet,打开VB的脚本窗口

在窗口输入一下。

3.开发者工具-宏-宏安全性  启用所有宏。

 

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
'让数据有效性选择 可以多选,重复选
Dim rngDV As Range
Dim oldVal As String
Dim tVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
tVal = ""
If oldVal = "" Then
Else
    If newVal = "" Then
    Else
        If InStr(1, "," & oldVal & ",", "," & newVal & ",") <> 0 Then '已存在
            tVal = Replace(Replace(oldVal & ",", newVal & ",", ""), ",,", ",")
            If InStr(Len(tVal), tVal, ",") <> 0 Then '判断最后一位是否逗号，是则不要最后一位
                tVal = Left(tVal, Len(tVal) - 1)
            End If
            Target.Value = tVal
        Else
            Target.Value = oldVal & "," & newVal
        End If
    End If
End If
End If

exitHandler:
Application.EnableEvents = True
End Sub