打開Exlce,
確定,然后
右擊查看代碼,把這段代碼復制到新建的文件里面
此時Excel會給出提示,選擇否,,系統會提示保存,在保存的時候選擇啟用宏的工作簿然后保存,此時Excel下拉框多選就搞定了,最后,代碼如下:
Option Explicit Sub Worksheet_Change(ByVal Target As Range) '讓數據有效性選擇 可以多選,重復選 Dim rngDV As Range Dim oldVal 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 If oldVal = "" Then Else If newVal = "" Then Else Target.Value = oldVal _ & ", " & newVal End If End If End If exitHandler: Application.EnableEvents = True End Sub
優化后的代碼
Option Explicit Sub Worksheet_Change(ByVal Target As Range) '讓數據有效性選擇 可以多選,重復選 Dim rngDV As Range Dim oldVal 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 If oldVal = "" Then Else If newVal = "" Then Else If Target.Column <> 2 And Target.Column <> 3 And Target.Column <> 5 Then Dim oldValArray oldValArray = Split(oldVal, ",") Dim exitVal As Boolean exitVal = False Dim i As Integer Dim resultVal As String For i = 0 To UBound(oldValArray) If oldValArray(i) = newVal Then exitVal = True Else If resultVal = "" Then resultVal = oldValArray(i) Else resultVal = resultVal & "," & oldValArray(i) End If End If Next If exitVal = False Then If oldVal = newVal Then Target.Value = resultVal Else Target.Value = resultVal & "," & newVal End If Else Target.Value = resultVal End If End If End If End If End If exitHandler: Application.EnableEvents = True End Sub
轉載自:https://www.cnblogs.com/boosasliulin/p/5970120.html