使用VBA实现用户窗体嵌套列表框从Excel数据表读取数据

第一步：创建数据存储工作表 #

新建一个名为BuilderData的工作表，按以下格式录入基础数据（后续新增建筑商、主管或电话时，直接添加新行即可）：

第二步：替换原有VBA代码 #

删除硬编码的旧代码，改用以下逻辑从BuilderData工作表读取数据并实现三级联动：

' 使用后期绑定字典，无需手动添加引用
Dim builderDict As Object
Dim supervisorDict As Object

Private Sub UserForm_Initialize()
    Set builderDict = CreateObject("Scripting.Dictionary")
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("BuilderData")
    
    ' 获取唯一建筑商列表填充第一个下拉框
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim i As Long
    For i = 2 To lastRow ' 从第2行开始，第1行视为表头
        If Not builderDict.Exists(ws.Cells(i, "A").Value) Then
            builderDict.Add ws.Cells(i, "A").Value, True
        End If
    Next i
    
    ComboBox2.List = builderDict.Keys
End Sub

Private Sub ComboBox2_Change()
    ComboBox3.Clear
    ComboBox4.Clear
    Set supervisorDict = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("BuilderData")
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 根据选中的建筑商筛选对应主管
    For i = 2 To lastRow
        If ws.Cells(i, "A").Value = ComboBox2.Value Then
            If Not supervisorDict.Exists(ws.Cells(i, "B").Value) Then
                supervisorDict.Add ws.Cells(i, "B").Value, True
            End If
        End If
    Next i
    
    ComboBox3.List = supervisorDict.Keys
End Sub

Private Sub ComboBox3_Change()
    ComboBox4.Clear
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("BuilderData")
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 根据选中的主管筛选对应电话号码
    For i = 2 To lastRow
        If ws.Cells(i, "B").Value = ComboBox3.Value And ws.Cells(i, "A").Value = ComboBox2.Value Then
            ComboBox4.AddItem ws.Cells(i, "C").Value
        End If
    Next i
End Sub

关键说明 #

• 后续更新数据只需在BuilderData工作表添加新行，无需修改VBA代码
• 代码自动去重，确保下拉框显示唯一的建筑商和主管名称
• 使用后期绑定字典，避免手动启用Microsoft Scripting Runtime引用的操作

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