【VBA案例010】下拉多选

1
Private Sub Worksheet_Change(ByVal Target As Range)
2

3
    Dim rngDV As Range
4
    Dim oldVal As String
5
    Dim newVal As String
6
    Dim fenGeFu As String
7

8
    If Target.CountLarge > 1 Then Exit Sub
9
    fenGeFu = "," '规定用逗号分隔
10

11
    On Error Resume Next
12
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
13

14
    If rngDV Is Nothing Then Exit Sub
15
    If Intersect(Target, rngDV) Is Nothing Then Exit Sub
16

17
    Application.EnableEvents = False
18
    newVal = Target.Value
19
    Application.Undo
20
    oldVal = Target.Value
21
    Target.Value = newVal
22

23
    If oldVal <> "" Then
24
        If newVal <> "" Then
25
            If InStr(fenGeFu & oldVal & fenGeFu, fenGeFu & newVal & fenGeFu) > 0 Then
26
                If InStrRev(oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then
27
                    Target.Value = Replace(oldVal, fenGeFu & newVal, "")
28
                Else
29
                    Target.Value = Replace(oldVal, newVal & fenGeFu, "")
30
                End If
31
            Else
32
                Target.Value = oldVal & fenGeFu & newVal
33
            End If
34
        End If
35
    End If
36

37
    Application.EnableEvents = True
38
End Sub