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