ExcelVBA字典實現窗體二級下拉菜單:
問題提出:
選擇確定ComboBox1中的數值後,ComboBox2的下拉列表自動引用ComboBox1中數值對應的列的內容。如何能做到,現在想在加壹重判斷:就是判斷ComboBox2中的數值,如果是原來ComboBox1對應列中已有的值,就直接向下進行,如果原來ComboBox1對應列中沒有該值,自動添加到該列最下壹個非空行之後再向下執行。
字典的引用:
窗體代碼如下:
Public Arr, Dic As New Dictionary'聲明為公***變量,引用“Microsoft Scripting Runtime”
Private Sub UserForm_Initialize() '窗體初始化事件
Dim Brr
Arr = Sheet1.Range("A1").CurrentRegion.Value'A1單元格已用區域
For i = 1 To UBound(Arr, 2)'循環標題,並添加到字典
If Not Dic.Exists(Arr(1, i)) Then'字典中不存在關鍵字
Dic.Add Arr(1, i), Dic.Count + 1'添加關鍵字,Item為索引
End If
Next
Brr = Dic.Keys
Me.ComboBox1.Clear'清除列表框1條目
For i = 0 To UBound(Brr) - 1'列表框1添加條目
Me.ComboBox1.AddItem Brr(i)
Next
End Sub
Private Sub ComboBox1_DropButtonClick() '列表框1下拉事件
Dim Brr
If Me.ComboBox1.Text = "" Then Exit Sub'如果列表框1為空,就退出過程
Me.ComboBox2.Clear'清空列表框2條目
If Dic.Exists(Me.ComboBox1.Text) Then '如果列表框的關鍵字,在字典中有記錄
Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text)) '用Index函數取出整列數據
For i = 2 To UBound(Brr, 1)'列表框2添加條目
Me.ComboBox2.AddItem Brr(i, 1)'列表框2添加條目
Next
End If
End Sub
Private Sub CommandButton1_Click() '按鈕1單擊事件
If Me.ComboBox1.Text = "" Or Me.ComboBox2.Text = "" Then Exit Sub'如果列表框1,2為空,就退出過程
Dim Brr, Crr
Brr = Application.WorksheetFunction.Index(Arr, 0, Dic(Me.ComboBox1.Text))'用Index函數取出整列數據
Crr = VBA.Filter(Application.Transpose(Brr), Me.ComboBox2.Text, True)'取出匹配列表框2的值
If UBound(Crr) = -1 Then?'如果有列表框2的值,數組不會為-1?,'如果列表框2中沒有此關鍵字,往原數據添加此關鍵字
Sheet1.Cells(Rows.Count, Dic(Me.ComboBox1.Text)).End(xlUp).Offset(1).Value = Me.ComboBox2.Text
End If
Sheet1.Cells(Rows.Count, 10).End(xlUp).Offset(1).Value = Me.ComboBox2.Text'+ Me.ComboBox1.Text?'把數據寫入單元格
Me.ComboBox1.Text = "": Me.ComboBox2.Text = ""'列表框1,2顯示為空白
Me.ComboBox1.Clear: Me.ComboBox2.Clear'清空列表框1,2的條目
Call UserForm_Initialize'初始化窗體,為下壹次錄入數據準備
End Sub
效果圖: