[已解决]二级下拉设置

c888

请教：
提取重名到二级下拉框中。谢谢！ 二级下拉设置.zip (13.19 KB, 下载次数: 15)

2021-1-21 23:15 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-1-25 22:43

c888 发表于 2021-1-25 22:12
谢谢老师，没有达到要求！是提取重名到第二级下拉框内。

Private Sub ComboBox1_Change()
    Set d = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    With Sheets("2")
        Hx = .Range("a65536").End(xlUp).Row
        arr = .Range("a2:c" & Hx)
    End With
    For x = 1 To UBound(arr)
    If arr(x, 2) = ComboBox1 Then
        If Not d.exists(arr(x, 3)) Then
           d.Add arr(x, 3), ""
        Else
           If Not d2.exists(arr(x, 3)) Then d2.Add arr(x, 3), ""
        End If
    End If
    Next
    ComboBox2.Clear
    ComboBox2.List = d2.keys
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

高

加了一个.text  可以在代码中查找text

c888

高 发表于 2021-1-22 17:29
加了一个.text  可以在代码中查找text

老师，给个写法，谢谢！

高

c888 发表于 2021-1-22 19:39
老师，给个写法，谢谢！

Private Sub ComboBox1_Change()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("2")
        Hx = .Range("a65536").End(xlUp).Row
        arr = .Range("a2:c" & Hx)
    End With
    For x = 1 To UBound(arr)
    If arr(x, 2) = ComboBox1.Text Then
        If Not d.exists(arr(x, 3)) Then d.Add arr(x, 3), ""   '提取重名
    End If
    Next
    ComboBox2.Clear
    ComboBox2.List = d.keys
End Sub
我在2楼的附件里有啊，只是我把里边的代码重新在这里发一下。其中的.Text 是我加的。

c888

高 发表于 2021-1-24 22:04
Private Sub ComboBox1_Change()
    Set d = CreateObject("scripting.dictionary")
    With Sheets( ...

谢谢老师，没有达到要求！是提取重名到第二级下拉框内。

cutecpu

c888 发表于 2021-1-25 22:12
谢谢老师，没有达到要求！是提取重名到第二级下拉框内。

Private Sub ComboBox1_Change()
    Set d = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    With Sheets("2")
        Hx = .Range("a65536").End(xlUp).Row
        arr = .Range("a2:c" & Hx)
    End With
    For x = 1 To UBound(arr)
    If arr(x, 2) = ComboBox1 Then
        If Not d.exists(arr(x, 3)) Then
           d.Add arr(x, 3), ""
        Else
           If Not d2.exists(arr(x, 3)) Then d2.Add arr(x, 3), ""
        End If
    End If
    Next
    ComboBox2.Clear
    ComboBox2.List = d2.keys
End Sub

祝順心，南無阿彌陀佛！

c888

cutecpu 发表于 2021-1-25 22:43
Private Sub ComboBox1_Change()
    Set d = CreateObject("scripting.dictionary")
    Set d2 = Cre ...

谢谢老师！