求助：基于Excel VBA开发带多动态关联组合框的用户窗体

Hey there! I get that setting up a cascading UserForm in VBA can feel overwhelming when you're just starting out. Let's break this down step by step so you can build exactly what you need.

1. Set Up Your UserForm & Controls #

First, create your UserForm and add these controls (make sure to name them exactly as listed below):

• ComboBoxes:
  • cboSource (maps to "Fiche Source" column)
  • cboDivision (maps to "Division" column)
  • cboProjectName (maps to "Nom Projet" column)
  • cboStatus (maps to "Statut Projet" column)
  • cboClient (maps to "Client" column)
  • cboRespPole (maps to "Pole" column)
  • cboRFC (maps to "RfC détail" column)
  • cboMonth (maps to "Mois" column)
• TextBox:
  • txtMaco (auto-fills "Projets en cours" based on selected project name)
• CommandButtons:
  • btnReset (label: "Reset All")
  • btnFilter (label: "Filter Selection")

2. Paste the VBA Code #

Right-click your UserForm in the VBA Editor and select View Code. Paste this code (comments are included to explain what each part does):

Option Explicit

' --------------------------
' ADJUST THESE CONSTANTS FIRST!
' Match the column numbers to your actual data sheet (headers in row 1)
' --------------------------
Private Const COL_FICHE_SOURCE As Integer = 1   ' Column for "Fiche Source"
Private Const COL_DIVISION As Integer = 2       ' Column for "Division"
Private Const COL_NOM_PROJET As Integer = 3     ' Column for "Nom Projet"
Private Const COL_PROJETS_EN_COURS As Integer = 4 ' Column for "Projets en cours"
Private Const COL_STATUT_PROJET As Integer = 5  ' Column for "Statut Projet"
Private Const COL_CLIENT As Integer = 6         ' Column for "Client"
Private Const COL_POLE As Integer = 7           ' Column for "Pole"
Private Const COL_RFC_DETAIL As Integer = 8     ' Column for "RfC détail"
Private Const COL_MOIS As Integer = 9           ' Column for "Mois"
Private Const DATA_SHEET_NAME As String = "Data" ' Name of your data sheet
' --------------------------

Private wsData As Worksheet

' Initialize the form: load first combo and clear others
Private Sub UserForm_Initialize()
    Set wsData = ThisWorkbook.Worksheets(DATA_SHEET_NAME)
    LoadUniqueValues cboSource, wsData.Columns(COL_FICHE_SOURCE)
    ClearControls
End Sub

' Load unique values from a column into a combo box
Private Sub LoadUniqueValues(cbo As MSForms.ComboBox, rng As Range)
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim cell As Range
    
    cbo.Clear
    For Each cell In rng
        If cell.Row > 1 And Not IsEmpty(cell.Value) Then ' Skip header row
            dict(cell.Value) = vbNullString ' Use dictionary to track unique values
        End If
    Next cell
    
    If dict.Count > 0 Then cbo.List = dict.Keys ' Load unique values into combo
End Sub

' Clear all dependent controls
Private Sub ClearControls()
    cboDivision.Clear
    cboProjectName.Clear
    txtMaco.Value = ""
    cboStatus.Clear
    cboClient.Clear
    cboRespPole.Clear
    cboRFC.Clear
    cboMonth.Clear
End Sub

' --------------------------
' Cascading Combo Change Events
' --------------------------
Private Sub cboSource_Change()
    ClearControls
    If cboSource.ListIndex <> -1 Then
        ' Load Division values filtered by selected Source
        LoadFilteredValues cboDivision, COL_DIVISION, Array(COL_FICHE_SOURCE, cboSource.Value)
    End If
End Sub

Private Sub cboDivision_Change()
    cboProjectName.Clear
    txtMaco.Value = ""
    cboStatus.Clear
    cboClient.Clear
    cboRespPole.Clear
    cboRFC.Clear
    cboMonth.Clear
    
    If cboDivision.ListIndex <> -1 And cboSource.ListIndex <> -1 Then
        ' Load Project Name values filtered by Source + Division
        LoadFilteredValues cboProjectName, COL_NOM_PROJET, Array(COL_FICHE_SOURCE, cboSource.Value, COL_DIVISION, cboDivision.Value)
    End If
End Sub

Private Sub cboProjectName_Change()
    txtMaco.Value = ""
    cboStatus.Clear
    cboClient.Clear
    cboRespPole.Clear
    cboRFC.Clear
    cboMonth.Clear
    
    If cboProjectName.ListIndex <> -1 And cboSource.ListIndex <> -1 And cboDivision.ListIndex <> -1 Then
        ' Auto-fill N° Maco from selected Project Name
        txtMaco.Value = GetMacoValue(cboProjectName.Value)
        
        ' Load remaining combos filtered by Source + Division + Project Name
        Dim filterCrit As Variant
        filterCrit = Array(COL_FICHE_SOURCE, cboSource.Value, COL_DIVISION, cboDivision.Value, COL_NOM_PROJET, cboProjectName.Value)
        
        LoadFilteredValues cboStatus, COL_STATUT_PROJET, filterCrit
        LoadFilteredValues cboClient, COL_CLIENT, filterCrit
        LoadFilteredValues cboRespPole, COL_POLE, filterCrit
        LoadFilteredValues cboRFC, COL_RFC_DETAIL, filterCrit
        LoadFilteredValues cboMonth, COL_MOIS, filterCrit
    End If
End Sub

' Load filtered unique values into a combo box
Private Sub LoadFilteredValues(cbo As MSForms.ComboBox, targetCol As Integer, filterPairs As Variant)
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim lastRow As Long, i As Long, j As Integer
    Dim isMatch As Boolean
    
    lastRow = wsData.Cells(wsData.Rows.Count, targetCol).End(xlUp).Row
    cbo.Clear
    
    For i = 2 To lastRow ' Skip header
        isMatch = True
        ' Check all filter criteria (column index + value pairs)
        For j = LBound(filterPairs) To UBound(filterPairs) Step 2
            If wsData.Cells(i, filterPairs(j)).Value <> filterPairs(j + 1) Then
                isMatch = False
                Exit For
            End If
        Next j
        
        If isMatch And Not IsEmpty(wsData.Cells(i, targetCol).Value) Then
            dict(wsData.Cells(i, targetCol).Value) = vbNullString
        End If
    Next i
    
    If dict.Count > 0 Then cbo.List = dict.Keys
End Sub

' Get the unique N° Maco for a selected Project Name
Private Function GetMacoValue(projectName As String) As String
    Dim lastRow As Long, i As Long
    lastRow = wsData.Cells(wsData.Rows.Count, COL_NOM_PROJET).End(xlUp).Row
    
    For i = 2 To lastRow
        If wsData.Cells(i, COL_NOM_PROJET).Value = projectName Then
            GetMacoValue = wsData.Cells(i, COL_PROJETS_EN_COURS).Value
            Exit Function ' Assumes one unique Maco per project
        End If
    Next i
    GetMacoValue = "" ' Return empty if no match found
End Function

' --------------------------
' Button Click Events
' --------------------------
Private Sub btnReset_Click()
    cboSource.Clear
    LoadUniqueValues cboSource, wsData.Columns(COL_FICHE_SOURCE)
    ClearControls
End Sub

Private Sub btnFilter_Click()
    ' Clear existing filters
    wsData.AutoFilterMode = False
    
    Dim filterRange As Range
    Set filterRange = wsData.Range("A1").CurrentRegion ' Assumes data is contiguous with headers in A1
    
    ' Collect all filter criteria
    Dim filterCols As Variant, filterVals As Variant
    filterCols = Array(COL_FICHE_SOURCE, COL_DIVISION, COL_NOM_PROJET, COL_STATUT_PROJET, COL_CLIENT, COL_POLE, COL_RFC_DETAIL, COL_MOIS)
    filterVals = Array(cboSource.Value, cboDivision.Value, cboProjectName.Value, cboStatus.Value, cboClient.Value, cboRespPole.Value, cboRFC.Value, cboMonth.Value)
    
    ' Apply filters for non-empty selections
    Dim i As Integer
    For i = LBound(filterCols) To UBound(filterCols)
        If filterVals(i) <> "" Then
            filterRange.AutoFilter Field:=filterCols(i), Criteria1:=filterVals(i)
        End If
    Next i
End Sub

3. Adjust for Your Data #

Before testing, make sure to update these parts in the code:

• Column Constants: Change the integer values to match the actual columns in your data sheet (e.g., if "Fiche Source" is in column C, set COL_FICHE_SOURCE = 3).
• Data Sheet Name: Update DATA_SHEET_NAME to the name of your sheet containing the data.

4. Test the Form #

• Run the UserForm (press F5 in the VBA Editor while the form is selected).
• Select a value from cboSource—you'll see cboDivision populate with only relevant options.
• Continue selecting values down the chain; txtMaco will auto-fill when you pick a project name.
• Use "Reset All" to clear all selections and start over.
• Click "Filter Selection" to apply your chosen filters to the data sheet.

Notes #

• The code uses late binding for the dictionary, so you don't need to enable any additional references.
• If a project name has multiple Maco numbers, the code will return the first one it finds. Let me know if you need to adjust this!

内容的提问来源于stack exchange，提问作者samirbhowmik