时间戳

首页 > 解决方案 > Excel VBA从工作表填充父子下拉源

excel - Excel VBA从工作表填充父子下拉源

问题描述

我有如下数据表和用户表单中的 2 个组合框，名称为 ComboBox1(parent) 和 ComboBox2(child)

Parent |Child
-------|------
  A    |   1
  A    |   2
  A    |   3
  X    |   100
  X    |   101
  X    |   102

使用下面的代码，我将不同的值带入了 Parent 组合。

Dim s As String, r As Integer, nr As Integer, wr, v
Set wr = Sheet1.Range("A1:A10")
nr = wr.Rows.Count
With ComboBox1
 .Clear
 For r = 1 To nr
  v = wr(r, 1)
  If InStr(s, v & ",") = 0 Then
   s = s & v & ","
   .AddItem (v)
  End If
 Next
End With

我正在寻找根据父组合中的选定值填充子组合的帮助！

标签： excelvba

解决方案

我建议使用 aDictionary来记住 ComboBox1 中的哪些条目已经存在，因为您可以轻松地使用dict.Exists(NewItem).

并且 ComboBox2 的数据需要在ComboBox1_Change事件上自动重新初始化。

请注意，您应该使用更具描述性的变量名称s, r, nr, wr, v是毫无意义的，而名称 like ComboRange1orNewItem对人类来说非常易读。让您的生活更轻松，并减少错误。

Option Explicit

Sub InitComboBox1()
    Dim ComboRange1 As Range
    Set ComboRange1 = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, "A").End(xlUp))

    ComboBox1.Clear

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To ComboRange1.Rows.Count
        Dim NewItem As String
        NewItem = ComboRange1.Cells(i, 1).Text

        If Not dict.Exists(NewItem) Then
            dict.Add NewItem, 0
            ComboBox1.AddItem NewItem
        End If
    Next i
End Sub

Private Sub ComboBox1_Change()
    Dim ComboRange2 As Range
    Set ComboRange2 = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, "A").End(xlUp)).Resize(ColumnSize:=2)

    ComboBox2.Clear

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To ComboRange2.Rows.Count
        If ComboRange2.Cells(i, 1).Text = ComboBox1.Value Then
            Dim NewItem As String
            NewItem = ComboRange2.Cells(i, 2).Text

            If Not dict.Exists(NewItem) Then
                dict.Add NewItem, 0
                ComboBox2.AddItem NewItem
            End If
        End If
    Next i
End Sub

推荐阅读