Excel UserForm实现Service联动下拉框及新增记录唯一ID生成

一、核心需求落地 #

• 实现Service下拉框（数据源：Lookup工作表G、H、I列）与Department下拉框（数据源：Staff工作表A列）的联动：选择部门后，自动加载对应服务选项
• 修复新增记录的唯一ID生成逻辑，避免空表或删除记录后出现异常

二、代码改造全流程 #

1. 基础模块（Module）代码优化 #

Option Explicit

Public Function GetRange() As Range
    ' 获取Staff工作表数据区域（自动排除表头）
    Set GetRange = shStaff.Range("A2").CurrentRegion
    If GetRange.Rows.Count > 1 Then
        Set GetRange = GetRange.Offset(1).Resize(GetRange.Rows.Count - 1)
    End If
End Function

' 删除指定行
Public Sub DeleteSelectedRow(ByVal row As Long)
    shStaff.Range("A2").Offset(row).EntireRow.Delete
End Sub

' 根据选中部门返回对应服务列表
' 注：需确保Lookup表中G-I列是名为tbService的结构化表，第一列是部门名称，后续列是服务选项
Public Function GetServicesByDepartment(ByVal deptName As String) As Variant
    Dim lookupTbl As ListObject
    Dim filteredRng As Range
    Dim arr As Variant
    
    Set lookupTbl = shLookup.ListObjects("tbService")
    ' 筛选匹配当前部门的行
    lookupTbl.Range.AutoFilter Field:=1, Criteria1:=deptName
    
    On Error Resume Next
    Set filteredRng = lookupTbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    lookupTbl.Range.AutoFilter ' 取消筛选
    
    If Not filteredRng Is Nothing Then
        arr = filteredRng.Value
        ' 提取服务列（此处对应表中第2-4列，即原G-I列的服务数据，可根据实际调整）
        GetServicesByDepartment = Application.Index(arr, 0, Array(2, 3, 4))
    Else
        GetServicesByDepartment = Array() ' 无匹配时返回空数组
    End If
End Function

' 获取部门列表
Public Function GetDepartments() As Variant
    GetDepartments = shLookup.ListObjects("tbDepartment").DataBodyRange.Value
End Function

' 生成唯一ID（兼容空表场景）
Public Function GetNewID() As Long
    Dim maxID As Variant
    maxID = WorksheetFunction.Max(shStaff.Range("A:A"))
    ' 空表时Max返回错误，默认设为0
    If IsError(maxID) Then maxID = 0
    GetNewID = maxID + 1
End Function

2. 编辑表单（formStaffDetailsEdit）改造 #

新增部门下拉框的联动事件，确保加载数据时自动匹配对应服务：

Option Explicit

Private m_currentRow As Long

Public Property Let currentRow(ByVal newCurrentRow As Long)
    m_currentRow = newCurrentRow
End Property

Private Sub UserForm_Activate()
    Call FillComboboxes
    Call LoadData
End Sub

Private Sub buttonClose_Click()
    Unload Me
End Sub

Private Sub buttonUpdate_Click()
    Call WriteDataToSheet
End Sub

' 部门选择变化时刷新服务下拉框
Private Sub comboDepartment_Change()
    Me.comboService.Clear
    If Me.comboDepartment.Value <> "" Then
        Me.comboService.List = GetServicesByDepartment(Me.comboDepartment.Value)
    End If
End Sub

Public Sub FillComboboxes()
    ' 先加载部门列表，服务下拉框等待选择后加载
    Me.comboDepartment.List = GetDepartments()
    Me.comboService.Clear
End Sub

Public Sub LoadData()
    With shStaff.Range("A2").Offset(m_currentRow)
        textboxID.Value = .Cells(1, 1).Value
        textboxFirstname.Value = .Cells(1, 2).Value
        textboxLastname.Value = .Cells(1, 3).Value
        ' 先加载部门，再匹配对应服务
        comboDepartment.Value = .Cells(1, 6).Value
        Me.comboService.List = GetServicesByDepartment(comboDepartment.Value)
        comboService.Value = .Cells(1, 4).Value
        OptionFulltime.Value = IIf(.Cells(1, 5).Value = "Full-time", True, False)
        OptionParttime.Value = IIf(.Cells(1, 5).Value = "Part-time", True, False)
    End With
End Sub

Private Function WriteDataToSheet()
    If MsgBox("是否保存此记录？", vbYesNo, "保存记录") = vbYes Then
        With shStaff.Range("A2").Offset(m_currentRow)
            .Cells(1, 1).Value = textboxID.Value
            .Cells(1, 2).Value = textboxFirstname.Value
            .Cells(1, 3).Value = textboxLastname.Value
            .Cells(1, 4).Value = comboService.Value
            .Cells(1, 5).Value = IIf(OptionFulltime.Value = True, "Full-time", "Part-time")
            .Cells(1, 6).Value = comboDepartment.Value
        End With
    End If
End Function

3. 新增表单（formStaffDetailsNew）改造 #

同步联动逻辑，确保新增时服务选项随部门变化：

Option Explicit

Private Sub UserForm_Initialize()
    Call CreateNewID
    Call InitializeControls
End Sub

Private Sub buttonClose_Click()
    Unload Me
End Sub

Private Sub buttonSave_Click()
    If MsgBox("是否保存此记录？", vbYesNo, "保存记录") = vbYes Then
        Call WriteDataToSheet
        Call EmptyTextboxes
        Call CreateNewID
    End If
End Sub

' 部门选择变化时刷新服务下拉框
Private Sub comboDepartment_Change()
    Me.comboService.Clear
    If Me.comboDepartment.Value <> "" Then
        Me.comboService.List = GetServicesByDepartment(Me.comboDepartment.Value)
        Me.comboService.ListIndex = 0 ' 默认选中第一个服务选项
    End If
End Sub

Private Sub CreateNewID()
    textboxID.Value = GetNewID()
End Sub

Private Function WriteDataToSheet()
    Dim newRow As Long
    With shStaff
        newRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(newRow, 1).Value = textboxID.Value
        .Cells(newRow, 2).Value = textboxFirstname.Value
        .Cells(newRow, 3).Value = textboxLastname.Value
        .Cells(newRow, 4).Value = comboService.Value
        .Cells(newRow, 5).Value = IIf(OptionFulltime.Value = True, "Full-time", "Part-time")
        .Cells(newRow, 6).Value = comboDepartment.Value
    End With
End Function

Public Sub EmptyTextboxes()
    Dim c As Control
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            c.Value = ""
        End If
    Next
    OptionFulltime.Value = True
    Me.comboDepartment.ListIndex = 0
    Me.comboService.Clear
End Sub

Public Sub InitializeControls()
    Me.comboDepartment.List = GetDepartments()
    Me.comboDepartment.ListIndex = 0
    Me.comboService.Clear
    OptionFulltime.Value = True
End Sub

三、关键注意事项 #

1. Lookup表结构适配：需确保Lookup工作表的G-I列已创建结构化表（名称设为tbService），第一列为部门名称，后续列为对应服务选项，若结构不同需调整GetServicesByDepartment中的筛选列和提取列索引
2. 唯一ID稳定性：优化后的ID生成逻辑兼容空表场景，若需更严谨（比如避免删除记录后ID重复），可将计数器存储在隐藏单元格或名称管理器中
3. 联动逻辑验证：测试时需确认选择不同部门后，服务下拉框是否正确加载对应选项，无匹配时显示空列表

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