Excel VBA 用户表单combobox1选择过滤combobox2基于combobox1选择

Question

所以我试图使用三个组合框来为数据输入提供一个选择列表。 我需要按以下顺序进行选择：区域 -> 站点 -> 维护工厂。 在区域 Combobox 中进行选择时，站点 Combobox 列表应过滤到与相应区域选择相关的选项。 我认为需要使用 pivot 表或 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

Answer 1

准备好，因为我要在这里重新构想你的整个代码。 我强烈建议您创建原始代码模块或工作簿的备份，因为存在巨大差异并且我们的想法没有正确对齐。

这将对您的表执行实时过滤，因此请记住使用此方法。

我确实对以下代码进行了一些测试，但我是人类，并且在 20 分钟左右的时间内将它们组合在一起。 在您完全测试代码并且对它感到满意之前，我不会在真实环境中实现这一点。

我只是想感谢您使用命名范围。 这使得编码变得更容易。

您必须启用Microsoft 脚本运行时库。 这用于从表中获取唯一值。 （ 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 。 我不是模块范围变量的忠实拥护者，但是当它们是用户窗体模块的私有变量时，我们通常可以相处。 现在代码模块中的其他功能可以访问这些。

我们重置了自动过滤并禁用了两个组合框，这两个组合框在为该区域做出选择之前不应使用。 只有在区域被选中后，下一个框才可供选择。 我们将使用组合框的更改事件来处理这些。

用户表单主要由combo_region_change和combo_site_change事件控制。 每次触发 region_change 时，它都会清除所有其他组合框以重新确定它的新值。 然后它将适当地重新过滤。 combo_site 做同样的事情，但它只清除维护框。 这些事件处理程序还根据它们的值确定启用了哪些其他组合框。 因此，例如，如果您在哪里完全清除站点框，它将再次禁用对植物框的访问。

最后你只有“填充潜艇”。 一旦触发了适当的事件处理程序，他们的工作就是（重新）填充下一个组合框。

提示：如果您觉得需要在关闭用户窗体后重置过滤器，您可以将重置它的代码放在UserForm_Terminate()事件中。 如果在运行之前启用或未启用自动过滤器，则对上述代码没有影响，因此这只是偏好。