Excel 用户表单上的依赖保管箱

Question

我想根据下拉框“部门”中的值（工作表“员工”A 列中的值）将下拉框“服务”（工作表“查找”列 G、H、I 中的值）更改为依赖下拉列表如果可能的话，为添加的新记录生成唯一 ID....

模块

Option Explicit

Public Function GetRange() As Range

    ' Get the data range from the Staff worksheet
    Set GetRange = shStaff.Range("A2").CurrentRegion
    ' remove the header from the range by moving the range down one row and
    ' then removing the last row.
    Set GetRange = GetRange.Offset(1).Resize(GetRange.Rows.Count - 1)

End Function

' Delete the row from the staff worksheet
Public Sub DeleteSelectedRow(ByVal row As Long)
    ' Offset moves the range a given number of rows
    shStaff.Range("A2").Offset(row).EntireRow.Delete
End Sub

' Return the list of countries from the Lookup table
Public Function GetServices() As Variant
    GetServices = shLookup.ListObjects("tbCountry").DataBodyRange.Value
End Function

' Return the list of departments from the Lookup table
Public Function GetDepartments() As Variant
    GetDepartments = shLookup.ListObjects("tbDepartment").DataBodyRange.Value
End Function

' Create the ID for a new record
Public Function GetNewID() As Long
    GetNewID = 1 + WorksheetFunction.Max(shStaff.Range("A2").CurrentRegion.columns(1))
End Function

formStaffDetails编辑

Option Explicit



Private m_currentRow As Long

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

' USERFORM EVENTS
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

' HELPER FUNCTION/SUBS
Public Sub FillComboboxes()

    ' Fill the comboboxes
    Me.comboService.List = GetServices()
    Me.comboDepartment.List = GetDepartments()
    
End Sub

' Load data from the worksheet to the controls
Public Sub LoadData()
    
    ' Offset moves the range the numbers of rows specified by m_currentRow
    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
        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)
        comboDepartment.Value = .Cells(1, 6).Value
    End With
    
End Sub

' Write the data to the worksheet from the controls
Private Function WriteDataToSheet()

    If MsgBox("Do you want to save this record?", vbYesNo, "Save record") = vbYes Then

        ' Offset moves the range by the numbers of rows specified by m_currentRow
        With shStaff.Range("A2").Offset(m_currentRow)

            ' copy the data to the controls
            .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

formStaffDetailsNew

Option Explicit




' USERFORM EVENTS
Private Sub UserForm_Initialize()
    Call CreateNewID
    Call InitializeControls
End Sub

Private Sub buttonClose_Click()
    Unload Me
End Sub

' Save the data
Private Sub buttonSave_Click()
        
    If MsgBox("Do you want to save this record?:", vbYesNo, "Save record") = vbYes Then
        ' Add the new staff member details to the worksheet
        Call WriteDataToSheet
        ' Remove data from textboxes
        Call EmptyTextboxes
        ' Create the new ID for the staff member
        Call CreateNewID
    End If
    
End Sub

' HELPER FUNCTION/SUBS
Private Sub CreateNewID()
    textboxID.Value = GetNewID()
End Sub

' Save the record and clear the data from the controls
Private Function WriteDataToSheet()

    Dim newRow As Long
    With shStaff

        ' Get the first blank row of data
        newRow = .Cells(.Rows.Count, 1).End(xlUp).row + 1
        
        ' Write the data
        .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

' Clear data from the textbox controls
Public Sub EmptyTextboxes()
    
    Dim c As Control
    ' Read through all the controls
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            c.Value = ""
        End If
    Next
    
End Sub

Public Sub InitializeControls()

    ' Fill the comboboxes and select the first item
    Me.comboService.List = GetServices()
    Me.comboService.ListIndex = 0
    Me.comboDepartment.List = GetDepartments()
    Me.comboDepartment.ListIndex = 0
    
    OptionFulltime.Value = True
    
End Sub

感谢任何帮助......

Answer 1

OOP怎么样？

让我们创建一个包含服务集合的部门对象（插入新的类模块并将其命名为cDepartment）：

Option Explicit

Dim sDepName As String
Dim cServices As New Collection


Public Property Get DepName() As String
    DepName = sDepName
End Property

Public Property Let DepName(sName As String)
    sDepName = sName
End Property

Public Property Get Services() As Collection
    Set Services = cServices
End Property

Public Property Set Services(oServices As Collection)
    Set cServices = oServices
End Property

然后将以下代码添加到您的用户窗体中（根据您的需要更改控件的名称）：

Option Explicit

Dim deps As New Collection


Private Sub CmbDepartments_Change()
    Dim dep As cDepartment, oSer As Variant
    
    Me.CmbServices.Clear
    
    Set dep = deps(Me.CmbDepartments.ListIndex + 1)
    For Each oSer In dep.Services
        Me.CmbServices.AddItem CStr(oSer)
    Next oSer
    
    Set dep = Nothing
End Sub

Private Sub UserForm_Initialize()
    Dim wbk As Workbook, wsh As Worksheet
    Dim c As Long, r As Long
    Dim dep As cDepartment
    
    Set wbk = ThisWorkbook
    Set wsh = wbk.Worksheets(1)
    
    For c = 0 To 2
        r = 1
        Set dep = New cDepartment
        dep.DepName = wsh.Range("G" & r).Offset(ColumnOffset:=c)
        deps.Add dep
        Me.CmbDepartments.AddItem dep.DepName
        r = 2
        Do While wsh.Range("G" & r).Offset(ColumnOffset:=c) <> ""
            dep.Services.Add wsh.Range("G" & r).Offset(ColumnOffset:=c)
            r = r + 1
        Loop
    Next c
    
    Set dep = Nothing
    Set wsh = Nothing
    Set wbk = Nothing
End Sub

尝试一下。