列表法输入，提高工作效率（更新已完成）

iris00

[quote]原帖由 ctp_119 于 2011-6-15 09:39 发表

重装系统好了。暂无它法。

呜呜。。。。。。。。。。

ctp_119

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Or Target.Row = 1 Then Exit Sub
   
3. If Target.Column <> 1 And Target.Column <> 2 Then Exit Sub
   
4. Dim dic As Object
   
5. Dim arr As Variant
   
6. Dim i As Integer
   
7. Dim j As Integer
   
8. Dim di As Object
   
9. Dim k As Variant
   
10. Set dic = CreateObject("scripting.dictionary")
    
11. Set di = CreateObject("scripting.dictionary")
    
12. With Sheets("sheet3")
    
13. arr = .Range("a2:b" & .Cells(Rows.Count, 1).End(xlUp).Row)
    
14. End With
    
15. If Target.Column = 1 Then
    
16. For i = 1 To UBound(arr)
    
17. dic(arr(i, 1)) = ""
    
18. Next i
    
19. With Target.Validation
    
20. .Delete
    
21. .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
22. Operator:=xlBetween, Formula1:=Join(dic.keys, ",")
    
23. End With
    
24. ElseIf Target.Column = 2 Then
    
25. If Target.Offset(0, -1) = "" Then Exit Sub
    
26. For j = 1 To UBound(arr)
    
27. If arr(j, 1) = Target.Offset(0, -1) Then
    
28. di(arr(j, 2)) = ""
    
29. End If
    
30. Next j
    
31. With Target.Validation
    
32. .Delete
    
33. .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
34. Operator:=xlBetween, Formula1:=Join(di.keys, ",")
    
35. End With
    
36. k = di.keys
    
37. Target = k(0)
    
38. End If
    
39. End Sub
    

复制代码

字典有效性输入法太妙了，简洁利索，运行速度快等优点。
最新更新，，，近期正在学习字典。以前没有发现。呵呵，字典真是太好了。。。比collection强多了。。。个人认为。

[ 本帖最后由 ctp_119 于 2011-6-24 07:34 编辑 ]

linweihong

谢谢楼主那么用心,学习一下

euroshooter

有用，顶起来

jiangjieyun

谢谢楼主分享！学习一下

佛山小老鼠

不错，整理辛苦，建议楼主把各楼层的附件上传的一楼，方便会员下载，或者建一个电梯也行

ctp_119

原帖由 佛山小老鼠 于 2011-6-24 22:28 发表
不错，整理辛苦，建议楼主把各楼层的附件上传的一楼，方便会员下载，或者建一个电梯也行

本来想编辑一楼的，可是现在编辑不了，锁住了。。。
谢谢小老鼠版主！
有时间我在整理一下，关键代码加上备注。。。

mao471023

标记下，以后学习

海洋123

建议帖子名字加个“数据有效性”之类的关键字，，这么好的帖子，我搜索不到啊

ctp_119

有效性可以搜到，前面有这个关键字。承蒙夸奖！