Excel VBA 用户窗体组合框1 选择根据组合框1 选择过滤组合框2

Question

所以我尝试使用三个组合框来提供数据输入的选择列表。我需要按以下顺序进行选择:区域 -> 站点 -> 维护工厂。在“区域组合框”中进行选择后，“站点组合框”列表应筛选出与相应区域选择相关的选项。我认为需要使用数据透视表或 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 分钟左右的时间内将其组合在一起。在您完全测试代码并熟悉它之前，我不会在实际环境中实现此功能。

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

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。我不太喜欢模块范围的变量，但当它们是用户表单模块的私有(private)变量时，我们通常可以相处融洽。现在代码模块中的其他函数可以访问这些。

我们重置了自动筛选功能，并禁用了在选择该区域之前不应使用的两个组合框。只有选择了区域后，才能选择下一个框。我们将使用组合框的更改事件来处理这些。

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

最后你就得到了“填充子项”。他们的工作只是在触发适当的事件处理程序后(重新)填充下一个组合框。

提示:如果您觉得在关闭用户表单后需要重置过滤，您可以将重置过滤的代码放在 UserForm_Terminate() 事件中。在运行之前是否启用自动过滤器对上面的代码没有影响，因此这只是首选项。