Excel VBA 用户窗体组合框 1 选择根据组合框 1 选择过滤组合框 2
Excel VBA Userform combobox1 selection filters combobox2 based off of combobox1 selection
所以我正在尝试使用三个组合框来获得用于数据输入的选择列表。我需要按以下顺序进行选择：区域 -> 站点 -> 维护工厂。在区域组合框中进行选择时，站点组合框列表应筛选出与相应区域选择相关的选项。我在想需要使用一个 pivot table 或 vLookup 但我不知所措并且不知道如何完成这项工作。请帮助并提前非常感谢。
Private Sub UserForm_Initialize()
Dim CreateBy As Range
Dim Region As Range
Dim Site As Range
Dim MaintPlant As Range
Dim Dept As Range
Dim Act As Range
Dim ImpActTyp As Range
Dim ValCat As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")
For Each CreateBy In ws.Range("RosterList")
With Me.CboCreateBy
.AddItem CreateBy.Value
End With
Next CreateBy
For Each Region In ws.Range("RegionList")
With Me.CboRegion
.AddItem Region.Value
End With
Next Region
For Each Site In ws.Range("SiteList")
With Me.CboSite
.AddItem Site.Value
End With
Next Site
For Each MaintPlant In ws.Range("MaintPlantList")
With Me.CboMntPlant
.AddItem MaintPlant.Value
End With
Next MaintPlant
For Each Dept In ws.Range("DeptList")
With Me.CboDept
.AddItem Dept.Value
End With
Next Dept
For Each Act In ws.Range("ActList")
With Me.CboAct
.AddItem Act.Value
End With
Next Act
For Each ImpActTyp In ws.Range("ImpActTypList")
With Me.CboImpActTyp
.AddItem ImpActTyp.Value
End With
Next ImpActTyp
For Each ValCat In ws.Range("ValCatList")
With Me.CboValCat
.AddItem ValCat.Value
End With
Next ValCat
Me.DateTextBox.Value = Format(Date, "Medium Date")
Me.PLife.Value = 0
Me.CSE.Value = 0
Me.CboRegion.SetFocus
End Sub
做好准备，因为我将在这里重新构想您的整个代码。我强烈建议您创建原始代码模块或工作簿的备份，只是因为存在巨大差异并且我们的想法没有正确对齐。
这将对您的 table 执行实时过滤，因此使用此方法时请牢记这一点。
我确实对以下代码进行了一些测试，但我是人类，并在 20 分钟左右的时间内将其组合在一起。在您完全测试了代码并且对它感到满意之前，我不会在真实环境中实现它。
我只想感谢您使用命名范围。这使编码变得更容易。
You must enable the Microsoft Scripting Runtime library. This is used to grab the unique values from your tables. (Tools > References)
首先，这里是用户表单代码模块的完整代码：
Option Explicit
Private ws As Worksheet
Private tblLO As ListObject
Private Sub combo_region_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
Me.combo_site.Clear
'This is the first filter, so no worries about clearing entire AutoFilter
tblLO.AutoFilter.ShowAllData
Select Case Me.combo_region.Value
Case ""
Me.combo_site.Value = ""
Me.combo_maintPlant.Value = ""
Me.combo_site.Enabled = False
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 1, Me.combo_region.Value
'Populate the site combo box with new data
populateSiteCombo
'Enable the Site Combobox for user input
Me.combo_site.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub combo_site_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
'Clear the filtering, then readd the Region's filter
tblLO.AutoFilter.ShowAllData
tblLO.Range.AutoFilter 1, Me.combo_region
Select Case Me.combo_site.Value
Case ""
Me.combo_maintPlant.Value = ""
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 2, Me.combo_site.Value
'Populate the Plant combo box with new data
populatePlantCombo
'Enable the Plant Combobox for user input
Me.combo_maintPlant.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub populatePlantCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("MaintPlantList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_maintPlant.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_maintPlant.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateSiteCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("SiteList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_site.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_site.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateRegionCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
arrReg = ws.Range("RegionList").Value
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_region.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
如果您决定向下滚动以了解这里发生了什么，那就太好了。
让我们从初始化开始：
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
我们定义了模块变量 ws 和 tblLO。我不是模块范围变量的巨大粉丝，但当它们是用户窗体模块的私有变量时，我们通常可以相处。现在代码模块中的其他函数可以访问这些。
我们重置了自动筛选并禁用了两个组合框，这两个组合框在为区域做出选择之前不应使用。只有选择区域后，才会出现下一个框可供选择。我们将使用组合框的 Change Events 来处理这些问题。
用户窗体主要由 combo_region_change 和 combo_site_change 事件控制。每次触发 region_change 时，它都会清除所有其他组合框以重新确定它的新值。然后它将适当地重新过滤。 combo_site 做同样的事情，但它只清除维护框。这些事件处理程序还根据它们的值确定启用哪些其他组合框。因此，如果您在哪里完全清除站点框，它将再次禁用对植物框的访问。
您终于有了“填充潜艇”。他们的工作只是在触发适当的事件处理程序后（重新）填充下一个组合框。
提示：如果您觉得在关闭用户表单后需要重置过滤，您可以将重置代码放在 UserForm_Terminate() 事件中。是否启用自动过滤器对上面的代码没有影响运行，所以这只是偏好。
所以我正在尝试使用三个组合框来获得用于数据输入的选择列表。我需要按以下顺序进行选择：区域 -> 站点 -> 维护工厂。在区域组合框中进行选择时，站点组合框列表应筛选出与相应区域选择相关的选项。我在想需要使用一个 pivot table 或 vLookup 但我不知所措并且不知道如何完成这项工作。请帮助并提前非常感谢。
Private Sub UserForm_Initialize()
Dim CreateBy As Range
Dim Region As Range
Dim Site As Range
Dim MaintPlant As Range
Dim Dept As Range
Dim Act As Range
Dim ImpActTyp As Range
Dim ValCat As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")
For Each CreateBy In ws.Range("RosterList")
With Me.CboCreateBy
.AddItem CreateBy.Value
End With
Next CreateBy
For Each Region In ws.Range("RegionList")
With Me.CboRegion
.AddItem Region.Value
End With
Next Region
For Each Site In ws.Range("SiteList")
With Me.CboSite
.AddItem Site.Value
End With
Next Site
For Each MaintPlant In ws.Range("MaintPlantList")
With Me.CboMntPlant
.AddItem MaintPlant.Value
End With
Next MaintPlant
For Each Dept In ws.Range("DeptList")
With Me.CboDept
.AddItem Dept.Value
End With
Next Dept
For Each Act In ws.Range("ActList")
With Me.CboAct
.AddItem Act.Value
End With
Next Act
For Each ImpActTyp In ws.Range("ImpActTypList")
With Me.CboImpActTyp
.AddItem ImpActTyp.Value
End With
Next ImpActTyp
For Each ValCat In ws.Range("ValCatList")
With Me.CboValCat
.AddItem ValCat.Value
End With
Next ValCat
Me.DateTextBox.Value = Format(Date, "Medium Date")
Me.PLife.Value = 0
Me.CSE.Value = 0
Me.CboRegion.SetFocus
End Sub
做好准备，因为我将在这里重新构想您的整个代码。我强烈建议您创建原始代码模块或工作簿的备份，只是因为存在巨大差异并且我们的想法没有正确对齐。
这将对您的 table 执行实时过滤，因此使用此方法时请牢记这一点。
我确实对以下代码进行了一些测试，但我是人类，并在 20 分钟左右的时间内将其组合在一起。在您完全测试了代码并且对它感到满意之前，我不会在真实环境中实现它。
我只想感谢您使用命名范围。这使编码变得更容易。
You must enable the Microsoft Scripting Runtime library. This is used to grab the unique values from your tables. (
Tools > References)
首先，这里是用户表单代码模块的完整代码：
Option Explicit
Private ws As Worksheet
Private tblLO As ListObject
Private Sub combo_region_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
Me.combo_site.Clear
'This is the first filter, so no worries about clearing entire AutoFilter
tblLO.AutoFilter.ShowAllData
Select Case Me.combo_region.Value
Case ""
Me.combo_site.Value = ""
Me.combo_maintPlant.Value = ""
Me.combo_site.Enabled = False
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 1, Me.combo_region.Value
'Populate the site combo box with new data
populateSiteCombo
'Enable the Site Combobox for user input
Me.combo_site.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub combo_site_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
'Clear the filtering, then readd the Region's filter
tblLO.AutoFilter.ShowAllData
tblLO.Range.AutoFilter 1, Me.combo_region
Select Case Me.combo_site.Value
Case ""
Me.combo_maintPlant.Value = ""
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 2, Me.combo_site.Value
'Populate the Plant combo box with new data
populatePlantCombo
'Enable the Plant Combobox for user input
Me.combo_maintPlant.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub populatePlantCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("MaintPlantList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_maintPlant.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_maintPlant.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateSiteCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("SiteList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_site.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_site.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateRegionCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
arrReg = ws.Range("RegionList").Value
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_region.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
如果您决定向下滚动以了解这里发生了什么，那就太好了。
让我们从初始化开始：
Private Sub UserForm_Initialize() Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var Set tblLO = ws.ListObjects("Table1") 'Module-defined var tblLO.AutoFilter.ShowAllData Me.combo_maintPlant.Enabled = False Me.combo_site.Enabled = False 'We only populate this one during init because the others 'will populate once a value is used in this box populateRegionCombo End Sub
我们定义了模块变量 ws 和 tblLO。我不是模块范围变量的巨大粉丝，但当它们是用户窗体模块的私有变量时，我们通常可以相处。现在代码模块中的其他函数可以访问这些。
我们重置了自动筛选并禁用了两个组合框，这两个组合框在为区域做出选择之前不应使用。只有选择区域后，才会出现下一个框可供选择。我们将使用组合框的 Change Events 来处理这些问题。
用户窗体主要由 combo_region_change 和 combo_site_change 事件控制。每次触发 region_change 时，它都会清除所有其他组合框以重新确定它的新值。然后它将适当地重新过滤。 combo_site 做同样的事情，但它只清除维护框。这些事件处理程序还根据它们的值确定启用哪些其他组合框。因此，如果您在哪里完全清除站点框，它将再次禁用对植物框的访问。
您终于有了“填充潜艇”。他们的工作只是在触发适当的事件处理程序后（重新）填充下一个组合框。
提示：如果您觉得在关闭用户表单后需要重置过滤，您可以将重置代码放在 UserForm_Terminate() 事件中。是否启用自动过滤器对上面的代码没有影响运行，所以这只是偏好。