使用VBA按地点统计在职员工数（去重+排除月末前离职人员）

一、公式解法（无需VBA） #

假设你的数据在Input表，列对应关系如下：

• A列：Employee（员工ID/姓名）
• B列：Location（地点）
• D列：Resigned?（离职日期，空值代表未离职）

要统计2024年5月31日的在职人数，输出表E列为地点，可在F列用以下公式实现去重+筛选：

简化版公式（合并未离职/离职日期达标判断） #

=SUMPRODUCT((Input!$B:$B=E2)*(IF(Input!$D:$D="",DATE(2024,5,31)+1,Input!$D:$D)>=DATE(2024,5,31))/COUNTIFS(Input!$A:$A,Input!$A:$A,Input!$B:$B,E2))

公式拆解说明 #

• (Input!$B:$B=E2)：匹配当前统计的地点
• IF(Input!$D:$D="",DATE(2024,5,31)+1,Input!$D:$D)>=DATE(2024,5,31)：判断员工未离职（空值）或离职日期在5月31日及之后
• /COUNTIFS(Input!$A:$A,Input!$A:$A,Input!$B:$B,E2)：对同一地点的重复员工只计数1次，实现去重

如果你的Status列直接标记「在职/离职」，可以用更简单的版本：

=SUMPRODUCT((Input!$B:$B=E2)*(Input!$C:$C="在职")/COUNTIFS(Input!$A:$A,Input!$A:$A,Input!$B:$B,E2))

二、VBA解法（自动统计到指定工作表） #

按Alt+F11打开VBA编辑器，插入新模块后粘贴以下代码：

Sub CountActiveEmployeesByLocation()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim lastRow As Long, i As Long
    Dim locationDict As Object, empDict As Object
    Dim targetDate As Date
    
    ' 设置目标月末日期（可修改为需要的月份）
    targetDate = DateSerial(2024, 5, 31)
    
    ' 指定数据源表和结果表（根据实际表名修改）
    Set wsInput = ThisWorkbook.Worksheets("Input")
    Set wsOutput = ThisWorkbook.Worksheets("Output")
    Set locationDict = CreateObject("Scripting.Dictionary")
    
    ' 获取数据源最后一行
    lastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历数据，按地点分组去重统计
    For i = 2 To lastRow ' 假设第1行是表头
        Dim empID As String, loc As String, resignDate As Variant
        empID = wsInput.Cells(i, "A").Value ' 员工列
        loc = wsInput.Cells(i, "B").Value ' 地点列
        resignDate = wsInput.Cells(i, "D").Value ' 离职日期列
        
        ' 判断是否为月末在职员工
        Dim isActive As Boolean
        isActive = False
        If IsEmpty(resignDate) Then
            isActive = True
        ElseIf IsDate(resignDate) And resignDate >= targetDate Then
            isActive = True
        End If
        
        If isActive Then
            ' 地点不存在则新建员工字典
            If Not locationDict.Exists(loc) Then
                Set empDict = CreateObject("Scripting.Dictionary")
                locationDict(loc) = empDict
            End If
            ' 员工ID加入字典自动去重
            locationDict(loc)(empID) = ""
        End If
    Next i
    
    ' 清空结果表原有数据（保留表头）
    wsOutput.Range("A2:B" & wsOutput.Rows.Count).ClearContents
    
    ' 写入统计结果
    Dim outputRow As Long
    outputRow = 2
    For Each loc In locationDict.Keys
        wsOutput.Cells(outputRow, "A").Value = loc
        wsOutput.Cells(outputRow, "B").Value = locationDict(loc).Count
        outputRow = outputRow + 1
    Next loc
    
    MsgBox "统计完成！共统计" & locationDict.Count & "个地点的在职员工数。", vbInformation
End Sub

代码调整说明 #

• 修改targetDate可切换统计的月末日期
• 可调整wsInput/wsOutput的表名，以及Cells(i, "A")这类列号匹配你的实际数据列
• 运行后会自动将每个地点的在职人数写入结果表，自动去重并排除提前离职人员

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