excel如何完成下拉框復(fù)選

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

Private Sub Worksheet_Change(ByVal Target As Range)

' Developed by Contextures Inc.

' www.contextures.com

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 Target.Column = 7 Then '這里規(guī)定好哪一列的數(shù)據(jù)有效性是多選的，A列是第1列，依次類推，如3就是C列，7就是G列

????If oldVal = "" Then

??????'do nothing

??????Else

??????If newVal = "" Then

??????'do nothing

??????Else

????????If InStr(1, oldVal, newVal) <> 0 Then? '重復(fù)選擇視同刪除

??????????If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then '最后一個(gè)選項(xiàng)重復(fù)

????????????Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)

??????????Else

????????????Target.Value = Replace(oldVal, newVal & ",", "") '不是最后一個(gè)選項(xiàng)重復(fù)的時(shí)候處理逗號(hào)

??????????End If

????????Else '不是重復(fù)選項(xiàng)就視同增加選項(xiàng)

????????Target.Value = oldVal & "," & newVal

'????? NOTE: you can use a line break,

'????? instead of a comma

'????? Target.Value = oldVal _

'??????? & Chr(10) & newVal

????????End If

??????End If

????End If

??End If

End If

??

exitHandler:

??Application.EnableEvents = True

End Sub