VBA竖列动态二级下拉菜单

活在理想的世界 · 发表于 2017-9-25 17:43

本帖最后由活在理想的世界于 2017-9-26 07:33 编辑

11111111111111111111111111111111111111111111111111111111111111111111111111

点点滴滴2017627 · 发表于 2017-9-25 17:45

活在理想的世界发表于 2017-9-25 17:42
把你错的附件发上来。

好的，多谢了。这你刚才下载的你的附件，出来的结果是错的。

1.rar (16.47 KB, 下载次数: 27)

活在理想的世界 · 发表于 2017-9-25 17:46

本帖最后由活在理想的世界于 2017-9-26 07:33 编辑

11111111111111111111111111111111111111111111111111111111111111

活在理想的世界 · 发表于 2017-9-25 17:50

本帖最后由活在理想的世界于 2017-9-26 07:32 编辑

11111111111111111111111111111111111111111111111111111111111

点点滴滴2017627 · 发表于 2017-9-25 17:56

活在理想的世界发表于 2017-9-25 17:46
怎么可能是错的？再看看。。。

问题是这么一列下来只有最下面的那一个可以，其他的类选择后不会更新后面的下拉菜单。 QQ截图20170925180040.png

活在理想的世界 · 发表于 2017-9-25 18:03

本帖最后由活在理想的世界于 2017-9-25 18:17 编辑

点点滴滴2017627 发表于 2017-9-25 17:56
问题是这么一列下来只有最下面的那一个可以，其他的类选择后不会更新后面的下拉菜单。

我明白你的意思了，是不能改对吗？用下面的代码吧，下面的没问题了。

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim dic As Object, eic As Object, arr()
k = Sheet2.Range("a1048576").End(3).Row - 1
x = Sheet1.Range("a1048576").End(3).Row - 1
Set dic = CreateObject("Scripting.Dictionary")
Set eic = CreateObject("Scripting.Dictionary")
arr = Sheet2.Range("a2").Resize(k, 2)
For i = 1 To UBound(arr)
dic(arr(i, 1)) = ""
Next
If x = 0 Then
Sheet1.Range("a" & x + 2).Validation.Delete
Sheet1.Range("a" & x + 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(dic.Keys, ",")
Else
Sheet1.Range("a" & Target.Row + 1).Validation.Delete
Sheet1.Range("a" & Target.Row + 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(dic.Keys, ",")
End If
On Error Resume Next
For i = 1 To UBound(arr)
If Sheet1.Range("a" & Target.Row) = arr(i, 1) Then
eic(arr(i, 2)) = ""
End If
Next
Sheet1.Range("b" & Target.Row).Validation.Delete
Sheet1.Range("b" & Target.Row).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(eic.Keys, ",")
Application.EnableEvents = True
End Sub

复制代码

点点滴滴2017627 · 发表于 2017-9-26 09:57

活在理想的世界发表于 2017-9-25 18:03
我明白你的意思了，是不能改对吗？用下面的代码吧，下面的没问题了。

OK,完美解决问题。

点点滴滴2017627 · 发表于 2017-9-26 10:07

活在理想的世界发表于 2017-9-25 18:03
我明白你的意思了，是不能改对吗？用下面的代码吧，下面的没问题了。

你好，我能在代码里自己写“类一“而不是根据左边的选取吗？多谢了。

oppo561314 · 发表于 2017-9-26 10:23

用有效性+函数就能搞定还是动态的何必要用VBA

活在理想的世界 · 发表于 2017-9-26 10:28

点点滴滴2017627 发表于 2017-9-26 10:07
你好，我能在代码里自己写“类一“而不是根据左边的选取吗？多谢了。

怎么个意思？是不需要数据库直接在内存里创建有效性吗？

		自动登录	找回密码
密码			免费注册

[求助] VBA竖列动态二级下拉菜单