如何按员工姓名数组顺序对Excel工作表进行排序？

可以实现按数组顺序对工作表排序，你的现有代码存在几个问题需要修正，以下是优化后的完整代码及说明：

问题分析 #

1. 循环变量类型错误：原代码中用Range类型变量遍历姓名数组，实际数组存储的是字符串，类型不匹配。
2. 去重逻辑可简化：无需额外的RemoveDupes函数，利用Collection的Key特性即可直接去重。
3. 缺少错误处理：未检查数组中的姓名是否对应存在的工作表，容易触发运行时错误。
4. 效率问题：未关闭屏幕刷新，移动工作表时会频繁闪烁，影响运行速度。

修正后的完整代码 #

Sub SortSheetsByEmployeeArray()
    Dim EmployeeNameRow As Long
    Dim EmployeeLastRow As Long
    Dim First_Name_Column As Integer, Last_Name_Column As Integer
    Dim FirstAndLastName As String
    Dim EmployeeNameArray As Collection
    Dim DeletedDuplicatesEmployeeNameArray As Variant
    Dim empName As Variant
    
    ' 获取Summary表中员工姓名数据的最后一行
    EmployeeLastRow = ThisWorkbook.Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
    
    First_Name_Column = 1 ' 对应A列（名）
    Last_Name_Column = 2  ' 对应B列（姓）
    
    ' 初始化集合用于存储员工姓名（利用Key自动去重）
    Set EmployeeNameArray = New Collection
    
    ' 从Summary表读取姓名并加入集合
    For EmployeeNameRow = 2 To EmployeeLastRow
        FirstAndLastName = Trim(ThisWorkbook.Sheets("Summary").Cells(EmployeeNameRow, First_Name_Column).Value) & " " & _
                           Trim(ThisWorkbook.Sheets("Summary").Cells(EmployeeNameRow, Last_Name_Column).Value)
        
        ' 跳过空姓名
        If FirstAndLastName <> " " Then
            On Error Resume Next ' 重复姓名时忽略报错
            EmployeeNameArray.Add FirstAndLastName, Key:=UCase(FirstAndLastName) ' Key不区分大小写
            On Error GoTo 0
        End If
    Next EmployeeNameRow
    
    ' 将集合转换为数组
    ReDim DeletedDuplicatesEmployeeNameArray(1 To EmployeeNameArray.Count)
    For EmployeeNameRow = 1 To EmployeeNameArray.Count
        DeletedDuplicatesEmployeeNameArray(EmployeeNameRow) = EmployeeNameArray(EmployeeNameRow)
    Next EmployeeNameRow
    
    ' 按数组顺序移动工作表：依次将每个目标表移到最后，最终顺序与数组一致
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行效率
    For Each empName In DeletedDuplicatesEmployeeNameArray
        ' 检查目标工作表是否存在
        On Error Resume Next
        Dim targetSheet As Worksheet
        Set targetSheet = ThisWorkbook.Sheets(empName)
        On Error GoTo 0
        
        If Not targetSheet Is Nothing Then
            targetSheet.Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        End If
    Next empName
    Application.ScreenUpdating = True ' 恢复屏幕刷新
End Sub

关键优化说明 #

• 用Collection的Key特性自动去重，省去自定义去重函数的麻烦，同时避免重复姓名被加入。
• 增加空姓名过滤，防止无效的工作表名操作。
• 加入工作表存在性检查，避免因姓名无对应工作表导致的报错。
• 关闭屏幕刷新，减少工作表移动时的界面闪烁，大幅提升代码运行速度。
• 修正循环变量类型，用Variant正确遍历姓名数组。

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