求ActiveX控件设置

广州明亮 · 发表于 2013-4-9 00:33

求助ActiveX控件设置.zip (44.65 KB, 下载次数: 86)

zhaogang1960 · 发表于 2013-4-9 02:22

请测试：

Dim d As Object, ds As Object
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub
[a8] = ComboBox1.Value
ComboBox2.Clear
ComboBox2.List = d(ComboBox1.Value).keys
End Sub
Private Sub ComboBox2_Change()
If ComboBox2.ListIndex = -1 Then Exit Sub
[a10] = ComboBox2.Value
ComboBox3.Clear
ComboBox3.List = ds(ComboBox1.Value & ComboBox2.Value).keys
End Sub
Private Sub ComboBox3_Change()
[b8] = ComboBox3.Value
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim arr, i&
Set d = CreateObject("scripting.dictionary")
Set ds = CreateObject("scripting.dictionary")
arr = Sheets("名单").Range("A1").CurrentRegion
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 4)) Then Set d(arr(i, 4)) = CreateObject("scripting.dictionary")
d(arr(i, 4))(arr(i, 7)) = ""
If Not ds.Exists(arr(i, 4) & arr(i, 7)) Then Set ds(arr(i, 4) & arr(i, 7)) = CreateObject("scripting.dictionary")
ds(arr(i, 4) & arr(i, 7))(arr(i, 3)) = ""
Next
ComboBox1.List = d.keys
ComboBox1.ListIndex = 0
End Sub

复制代码

zhaogang1960 · 发表于 2013-4-9 02:22

请看附件

求助ActiveX控件设置.rar (56.96 KB, 下载次数: 78)

crazy0qwer · 发表于 2013-4-9 02:38

本帖最后由 crazy0qwer 于 2013-4-9 03:11 编辑

'---------------------------------------Sheet1 代码
Private Sub ComboBox1_Change()
Dim Ar, I As Long
On Error Resume Next
Ar = Split(D1(ComboBox1.Text), ",")
ComboBox2.Clear
For I = 0 To UBound(Ar)
ComboBox2.AddItem Ar(I)
Next
End Sub
Private Sub ComboBox2_Change()
Dim Ar, I As Long
Ar = Split(D2(ComboBox1.Text & ComboBox2.Text), ",")
ComboBox3.Clear
For I = 0 To UBound(Ar)
ComboBox3.AddItem Ar(I)
Next
End Sub
Private Sub Worksheet_Activate()
Call auto_open
End Sub
'-----------------------------------------------------模块代码
Public D1 As Object, D2 As Object
Sub auto_open()
Dim Ar, I As Long
Ar = Worksheets("名单").[A1].CurrentRegion
Set D1 = CreateObject("scripting.dictionary")
Set D2 = CreateObject("scripting.dictionary")
D1.RemoveAll
D2.RemoveAll
Worksheets("选择").ComboBox1.Clear
For I = 2 To UBound(Ar)
If D1.Exists(Ar(I, 4)) = False Then Worksheets("选择").ComboBox1.AddItem Ar(I, 4)
D1(Ar(I, 4)) = IIf(InStr(D1(Ar(I, 4)), Ar(I, 7)) = 0, D1(Ar(I, 4)) & Ar(I, 7) & ",", D1(Ar(I, 4)))
D2(Ar(I, 4) & Ar(I, 7)) = D2(Ar(I, 4) & Ar(I, 7)) & Ar(I, 3) & ","
Next
End Sub

复制代码

求助ActiveX控件设置.rar (57.94 KB, 下载次数: 37)

广州明亮 · 发表于 2013-4-9 02:48

zhaogang1960 发表于 2013-4-9 02:22
请看附件

非常感谢您的帮助！但第一步就不能选择队伍的（只能选择小熊队，其他不能）？？？

广州明亮 · 发表于 2013-4-9 03:15

crazy0qwer 发表于 2013-4-9 02:38

感谢您的帮助！！！但选择后没有在规定单元格内显示哦？请问怎样调整？谢谢！

crazy0qwer · 发表于 2013-4-9 03:25

广州明亮发表于 2013-4-9 03:15
感谢您的帮助！！！但选择后没有在规定单元格内显示哦？请问怎样调整？谢谢！

你要显示哪三个单元格？把控件的属性关联到对应单元格就可以了。
打开工作簿，和激活控件所在表可以重新获取数据
因为如果用点击组合框就去获取数据的话，如果数据量大会比较卡，所以在启动的时候，还有重新激活这个表的时候去获取。

广州明亮 · 发表于 2013-4-9 03:45

crazy0qwer 发表于 2013-4-9 03:25
你要显示哪三个单元格？把控件的属性关联到对应单元格就可以了。
打开工作簿，和激活控件所在表可以重 ...

问题解决。非常感谢您的帮助！！！{:soso_e196:}

crazy0qwer · 发表于 2013-4-9 03:55

广州明亮发表于 2013-4-9 03:45
问题解决。非常感谢您的帮助！！！

换下面这个试试，从版主那学了点东西。。。

'-----------------------------------------------------模块代码
Public D1 As Object, D2 As Object
Sub auto_open()
Dim Ar, I As Long
Ar = Worksheets("名单").[A1].CurrentRegion
Set D1 = CreateObject("scripting.dictionary")
Set D2 = CreateObject("scripting.dictionary")
D1.RemoveAll
D2.RemoveAll
For I = 2 To UBound(Ar)
D1(Ar(I, 4)) = IIf(InStr(D1(Ar(I, 4)), Ar(I, 7)) = 0, D1(Ar(I, 4)) & Ar(I, 7) & ",", D1(Ar(I, 4)))
D2(Ar(I, 4) & Ar(I, 7)) = D2(Ar(I, 4) & Ar(I, 7)) & Ar(I, 3) & ","
Next
Worksheets("选择").ComboBox1.Clear
Worksheets("选择").ComboBox1.List = D1.keys
End Sub
'---------------------------------------Sheet1 代码
Private Sub ComboBox1_Change()
ComboBox2.Clear
ComboBox2.List = Split(D1(ComboBox1.Text), ",")
End Sub
Private Sub ComboBox2_Change()
ComboBox3.Clear
ComboBox3.List = Split(D2(ComboBox1.Text & ComboBox2.Text), ",")
End Sub
Private Sub Worksheet_Activate()
Call auto_open
End Sub

复制代码

广州明亮 · 发表于 2013-4-9 04:14

{:soso_e189:}{:soso_e179:}{:soso_e181:}{:soso_e183:}

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

[求助] 求ActiveX控件设置