VBA实现按职级统计出勤人力（含半日/全日变量计算）

核心实现逻辑 #

用**字典（Dictionary）**统计各职级累计出勤人力——字典的键（Key）唯一对应职级名称，值（Item）存储该职级的累计人力值，直接解决重复条目问题。具体步骤：

1. 遍历用户选中的所有员工
2. 从WorkerRankList区域匹配每个员工对应的职级
3. 按职级累加p值（全日1/半日0.5）到字典中
4. 将字典的键值对格式化为指定字符串，写入B列

完整VBA代码示例 #

' 处理选中员工并生成统计结果的核心代码
Sub GenerateManpowerStats()
    Dim ws As Worksheet
    Dim workerRankRng As Range
    Dim selectedNames As Variant
    Dim dict As Object
    Dim i As Integer, j As Integer
    Dim p As Double
    Dim targetCell As Range
    Dim resultStr As String
    Dim key As Variant
    
    ' 初始化基础变量
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的实际工作表名
    Set workerRankRng = ws.Range("WorkerRankList") ' 职级数据区域
    Set dict = CreateObject("Scripting.Dictionary") ' 创建字典对象
    p = 1 ' 根据实际场景设置为1（全日）或0.5（半日）
    Set targetCell = ws.Range("B1") ' 结果写入B列的目标单元格
    
    ' ------------------------------
    ' 从用户窗体lstDV获取选中的员工姓名
    ReDim selectedNames(lstDV.ListCount - 1)
    j = 0
    For i = 0 To lstDV.ListCount - 1
        If lstDV.Selected(i) Then
            selectedNames(j) = lstDV.List(i)
            j = j + 1
        End If
    Next i
    ReDim Preserve selectedNames(j - 1)
    ' ------------------------------
    
    ' 遍历选中员工，匹配职级并累加人力
    For i = LBound(selectedNames) To UBound(selectedNames)
        ' 用VLookup快速匹配员工职级（比循环更高效）
        rankName = Application.VLookup(selectedNames(i), workerRankRng, 2, False)
        
        ' 更新字典：职级已存在则累加p，不存在则新增条目
        If dict.Exists(rankName) Then
            dict(rankName) = dict(rankName) + p
        Else
            dict(rankName) = p
        End If
    Next i
    
    ' 格式化统计结果字符串
    resultStr = "Total manpower: "
    For Each key In dict.Keys
        resultStr = resultStr & key & "*" & dict(key) & ", "
    Next key
    ' 移除末尾多余的逗号和空格
    resultStr = Left(resultStr, Len(resultStr) - 2)
    
    ' 将结果写入目标单元格
    targetCell.Value = resultStr
End Sub

关键细节说明 #

• 字典对象：CreateObject("Scripting.Dictionary")无需额外引用，适合新手直接使用；若要提前引用，可在VBA编辑器中勾选「工具→引用→Microsoft Scripting Runtime」。
• 职级匹配：用Application.VLookup替代循环遍历，数据量大时效率更高；若担心员工姓名重复，可结合员工ID做匹配。
• 结果格式化：遍历字典键值对拼接字符串，最后用Left函数移除末尾多余的分隔符，保证输出格式整洁。

示例验证 #

对应你给出的场景：

• 场景1：选中Peter、John、Tom、Mary、Sally、Carrie，p=1，输出：Total manpower: Junior*3, Officer*2, Supervisor*1
• 场景2：相同选中员工，p=0.5，输出：Total manpower: Junior*1.5, Officer*1, Supervisor*0.5

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