基于员工工作表的VBA数据拆分代码修改需求

This VBA script will:

• Pull a dynamic list of unique employee names from the employees worksheet
• Create individual worksheets for each employee, copying all matching rows from your source data
• Route any rows with unrecognized names to a UNMONITORED worksheet

Modified Code #

Sub DistributeEmployeeData()
    Dim wsSource As Worksheet, wsEmployees As Worksheet, wsDest As Worksheet, wsUnmonitored As Worksheet
    Dim employeeArr As Variant, uniqueEmployees As Collection
    Dim lastRowSource As Long, lastRowEmployees As Long, i As Long, j As Long
    Dim empName As String, found As Boolean
    
    ' Set references to source and employees sheets
    Set wsSource = ThisWorkbook.Worksheets("SourceData") ' Replace with your actual source sheet name
    Set wsEmployees = ThisWorkbook.Worksheets("employees")
    
    ' Extract unique employee names from employees sheet (dynamic range)
    lastRowEmployees = wsEmployees.Cells(wsEmployees.Rows.Count, "A").End(xlUp).Row
    Set uniqueEmployees = New Collection
    
    On Error Resume Next
    For i = 2 To lastRowEmployees ' Assumes header is in row 1
        empName = Trim(wsEmployees.Cells(i, "A").Value)
        If empName <> "" Then
            uniqueEmployees.Add empName, Key:=empName
        End If
    Next i
    On Error GoTo 0
    
    ' Convert collection to array for easier processing
    ReDim employeeArr(1 To uniqueEmployees.Count)
    For i = 1 To uniqueEmployees.Count
        employeeArr(i) = uniqueEmployees(i)
    Next i
    
    ' Set up UNMONITORED sheet (create if missing, clear existing data if present)
    On Error Resume Next
    Set wsUnmonitored = ThisWorkbook.Worksheets("UNMONITORED")
    If Err.Number <> 0 Then
        Set wsUnmonitored = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsUnmonitored.Name = "UNMONITORED"
        wsSource.Rows(1).Copy wsUnmonitored.Rows(1) ' Copy header
    Else
        wsUnmonitored.Rows("2:" & wsUnmonitored.Rows.Count).ClearContents
    End If
    On Error GoTo 0
    
    ' Process each employee in the array
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    For i = 1 To UBound(employeeArr)
        empName = employeeArr(i)
        
        ' Create or prepare employee-specific sheet
        On Error Resume Next
        Set wsDest = ThisWorkbook.Worksheets(empName)
        If Err.Number <> 0 Then
            Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            wsDest.Name = empName
            wsSource.Rows(1).Copy wsDest.Rows(1) ' Copy header
        Else
            wsDest.Rows("2:" & wsDest.Rows.Count).ClearContents
        End If
        On Error GoTo 0
        
        ' Copy matching rows to the employee sheet
        Dim destRow As Long
        destRow = 2
        For j = 2 To lastRowSource ' Assumes header is in row 1 of source
            If Trim(wsSource.Cells(j, "A").Value) = empName Then
                wsSource.Rows(j).Copy wsDest.Rows(destRow)
                destRow = destRow + 1
            End If
        Next j
    Next i
    
    ' Route unmatched rows to UNMONITORED sheet
    Dim unmonRow As Long
    unmonRow = 2
    For j = 2 To lastRowSource
        found = False
        empName = Trim(wsSource.Cells(j, "A").Value)
        
        ' Check if name exists in the employee array
        For i = 1 To UBound(employeeArr)
            If empName = employeeArr(i) Then
                found = True
                Exit For
            End If
        Next i
        
        If Not found And empName <> "" Then
            wsSource.Rows(j).Copy wsUnmonitored.Rows(unmonRow)
            unmonRow = unmonRow + 1
        End If
    Next j
    
    MsgBox "Data distribution completed!", vbInformation
End Sub

Key Changes from Original Code #

• Dynamic Employee Source: Pulls unique names from the employees worksheet instead of generating from source data column A
• UNMONITORED Sheet Handling: Automatically creates the sheet if missing, or clears existing data (preserving headers) for unmatched entries
• Error Prevention: Safely checks for existing worksheets to avoid duplicate name errors and skips empty employee names
• Consistent Headers: Copies the source sheet header to all new/cleared sheets for uniformity

Dataset Example #

SourceData Worksheet #

employees Worksheet #

Expected Result #

• Three sheets created: John Doe, Jane Smith, Bob Brown with their respective data rows
• UNMONITORED sheet contains the row with "Unknown"

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