【杂类】Excel使用vba下拉框多选(.xlsm .xls)

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
'不做任何事情
Else
  '规定好哪一列的数据有效性是多选的,A列是第1列,B列是第2列,依次类推
  If Target.Column = 6 Then
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If oldVal = "" Then
    '不做任何事情
    Else
      If newVal = "" Then
      '不做任何事情
      Else
        '去除重复的字段
        If InStr(1, oldVal, newVal) <> 0 Then
          Target.Value = oldVal
        Else '不是重复选项就视同增加选项
          Target.Value = oldVal & "|" & newVal
        End If
      End If
    End If
  End If
End If

exitHandler:
Application.EnableEvents = True
End Sub

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值