单元格内数据有效性选项的下拉多选

楼主嘉昆2011	参考链接： http://blog.contextures.com/archives/2009/09/18/select-multiple-items-from-excel-data-validation-list/ 问题陈述：如何在单元格中实现数据有效性选项的复选，最终在单元格中显示所有选项？效果图：代码： Private Sub Worksheet_Change(ByVal Target As Range) Dim rngDV As Range Dim oldVal As String, newVal As String Dim Pos As Long On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) '设定含有数据有效性的区域 If Not (Application.Intersect(Target, rngDV) Is Nothing) Then Application.EnableEvents = False newVal = Target.Value Application.Undo oldVal = Target.Value Pos = InStr(1, oldVal, newVal) '利用InStr函数二进制比较返回newVal在oldVal中首次出现的位置 If Pos > 0 Then If Right(oldVal, Len(newVal)) = newVal Then '考虑撤选的两种情况 Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2) Else Target.Value = Replace(oldVal, newVal & ", ", "") End If Else If Len(oldVal) = 0 Then '考虑添选的两种情况 Target.Value = newVal Else Target.Value = oldVal & ", " & newVal End If End If Application.EnableEvents = True End If End Sub 附件： ET_DVMultipleItems_1024.rar
2楼 peakchu	占座学习
3楼 leo112233	真的帮助了非常大的忙** 另外有疑问（已选择后再次选择相同项为悔选消掉，但最后留一个时无法实现悔选，就算编辑单元格内容删掉也留有不完整的信息）该单元格不支持复制黏贴的吗？哈哈~谢谢昆哥的帮忙
4楼 bensonlei	不错！学习来了。
5楼闻启学	精彩版主
6楼 wumin88838	学习了
7楼 QQDD	太棒了！
8楼 QQDD	要是能有复选框，一次就选择完毕就更棒了
9楼 kobunei2013	疑问：多选后，不能使用键盘上的“Backspace”键删除了，该怎么办呢？
10楼 andme	就是牛！要的就是这种方法
11楼老糊涂	下载学习了
12楼圈圈_。o_○	看不懂
13楼 Leah	怎么不能新插入行？？！
14楼 pyatov	很有用学习了
15楼 pyatov	还是不太明白那段代码要复制到哪里去呢
16楼嘉昆2011	Alt+F11，点击相关的工作表，选取Worksheet_Change事件，粘帖即可。
17楼 yytax2010	思路巧妙
18楼 yytax2010	使用delete键不能删除单元格。
19楼 yytax2010	请求解决单元格一键删除问题。
20楼 111111	如何指定到某一列才触发这个复选事件啊
21楼嘉昆2011	参考链接： http://blog.contextures.com/archives/2009/09/18/select-multiple-items-from-excel-data-validation-list/ 问题陈述：如何在单元格中实现数据有效性选项的复选，最终在单元格中显示所有选项？效果图：代码： Private Sub Worksheet_Change(ByVal Target As Range) Dim rngDV As Range Dim oldVal As String, newVal As String Dim Pos As Long On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) '设定含有数据有效性的区域 If Not (Application.Intersect(Target, rngDV) Is Nothing) Then Application.EnableEvents = False newVal = Target.Value Application.Undo oldVal = Target.Value Pos = InStr(1, oldVal, newVal) '利用InStr函数二进制比较返回newVal在oldVal中首次出现的位置 If Pos > 0 Then If Right(oldVal, Len(newVal)) = newVal Then '考虑撤选的两种情况 Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2) Else Target.Value = Replace(oldVal, newVal & ", ", "") End If Else If Len(oldVal) = 0 Then '考虑添选的两种情况 Target.Value = newVal Else Target.Value = oldVal & ", " & newVal End If End If Application.EnableEvents = True End If End Sub 附件： ET_DVMultipleItems_1024.rar
22楼 peakchu	占座学习
23楼 leo112233	真的帮助了非常大的忙** 另外有疑问（已选择后再次选择相同项为悔选消掉，但最后留一个时无法实现悔选，就算编辑单元格内容删掉也留有不完整的信息）该单元格不支持复制黏贴的吗？哈哈~谢谢昆哥的帮忙
24楼 bensonlei	不错！学习来了。
25楼闻启学	精彩版主
26楼 wumin88838	学习了
27楼 QQDD	太棒了！
28楼 QQDD	要是能有复选框，一次就选择完毕就更棒了
29楼 kobunei2013	疑问：多选后，不能使用键盘上的“Backspace”键删除了，该怎么办呢？
30楼 andme	就是牛！要的就是这种方法