Access挑战Excel第三期：级联菜单

pureshadow

动态的问题不大，但乱序的数据有效性不行，要用VBA

pureshadow

roych 发表于 2016-3-23 12:18
就想挑战下小妖姐姐的极限。
我上传的那个答案还是比较low的。

这两天没空，等有空了就来接招，另外，也欢迎其他会Excel的同学接招，最近Access有点气焰嚣张……

pureshadow

做了两个:一个是纯函数版，不过函数有限制，所以没有用所有的数据，而且因为在数据验证中无法使用多维引用和内存数组，所以对数据源结构作了些修改。

1. 
   
2. =OFFSET($E$2,,,COUNTA($E:$E))
   
3. =OFFSET($B$1,MATCH($H$3,$A:$A,)-1,,COUNTIF($A:$A,$H$3))
   
4. =OFFSET($B$1,MATCH($H$5,$A:$A,)-1,,COUNTIF($A:$A,$H$5))
   

复制代码

另一个是代码版，这个除了生孩子其他什么都会的代码，就没那么多顾虑了，数据源该是什么样就是什么样。

1. 
   
2. Private Sub Worksheet_selectionChange(ByVal Target As Range)
   
3. 
   
4. Dim MyRow As Long, i As Long
   
5. Dim MyStr As String
   
6. MyRow = Cells(Rows.Count, 1).End(xlUp).Row
   
7. 
   
8. '省
   
9. If Target.Address = "$G$4" Then
   
10.     For i = 2 To MyRow
    
11.         If Application.CountIf(Range("a1:a" & i - 1), Cells(i, 1)) = 0 Then
    
12.             MyStr = MyStr & "," & Cells(i, 1)
    
13.         End If
    
14.     Next
    
15.     MyStr = Mid(MyStr, 2, MyRow * 8)
    
16.     With Target.Validation
    
17.         .Delete
    
18.         .Add Type:=xlValidateList, Formula1:=MyStr
    
19.     End With
    
20. End If
    
21. 
    
22. '市
    
23. If Target.Address = "$G$6" Then
    
24.     For i = 2 To MyRow
    
25.         If Cells(i, 1) = Range("g4") Then
    
26.             If Application.CountIf(Range("b1:b" & i - 1), Cells(i, 2)) = 0 Then
    
27.                 MyStr = MyStr & "," & Cells(i, 2)
    
28.             End If
    
29.         End If
    
30.     Next
    
31.     MyStr = Mid(MyStr, 2, MyRow * 8)
    
32.     With Target.Validation
    
33.         .Delete
    
34.         .Add Type:=xlValidateList, Formula1:=MyStr
    
35.     End With
    
36. End If
    
37. 
    
38. '县
    
39. If Target.Address = "$G$8" Then
    
40.     For i = 2 To MyRow
    
41.         If Cells(i, 2) = Range("g6") Then
    
42.             If Application.CountIf(Range("c1:c" & i - 1), Cells(i, 3)) = 0 Then
    
43.                 MyStr = MyStr & "," & Cells(i, 3)
    
44.             End If
    
45.         End If
    
46.     Next
    
47.     MyStr = Mid(MyStr, 2, MyRow * 8)
    
48.     With Target.Validation
    
49.         .Delete
    
50.         .Add Type:=xlValidateList, Formula1:=MyStr
    
51.     End With
    
52. End If
    
53. 
    
54. End Sub
    
55. 
    

复制代码

pureshadow

那个Roy，我一直没明白Access这个究竟是怎么做的，能扫下盲不？

pureshadow

Roy，原谅我笨，还是没搞定……
提个小小的要求，能做个视频什么的吧