Excel实现下拉多选——VBA

客户的一个需求,一次性导入的excel要做下拉多选

客户自己填逗号会死么,会死么

mac的wps不支持开发工具,需要用office,直接开发工具 VB点开复制进入即可

Private Sub WorkSheet_Change(ByVal Target As Range)

Dim values As Range
Dim newVal As String
Dim oldVal As String

If Target.Count > 1 Then GoTo exitHandler

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

If values Is Nothing Then GoTo exitHandler

If Intersect(Target, values) Is Nothing Then
Else

Application.EnableEvents = False
newVal = Target.Value
If Target.column = 5 Then '指定列 4 Or 5 Or 6
Application.Undo

oldVal = Target.Value
Target.Value = newVal

If oldVal = "" Then
Else
If newVal = "" Then
Else
    If InStr(1, oldVal, newVal) <> 0 Then
        If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then
            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
        Else
            Target.Value = Replace(oldVal, newVal & ",", "") '逗号分隔
        End If
    Else
Target.Value = oldVal & "," & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub

ps. 文件记得保存成xlsm