# 使用Excel VBA高效审计钉钉打卡记录，快速识别代打卡行为

- 连结：https://blog.guohao.asia/%e4%bd%bf%e7%94%a8excel-vba%e9%ab%98%e6%95%88%e5%ae%a1%e8%ae%a1%e9%92%89%e9%92%89%e6%89%93%e5%8d%a1%e8%ae%b0%e5%bd%95%ef%bc%8c%e5%bf%ab%e9%80%9f%e8%af%86%e5%88%ab%e4%bb%a3%e6%89%93%e5%8d%a1%e8%a1%8c.html
- 发布时间：2025-08-28T16:42:36+08:00
- 作者：null

来自 AI 助手的总结

某项目发现员工虚假打卡，集团将用 Excel VBA 审计全部员工打卡记录以排查代打卡行为。

中文   英文   韩语   日语

近期，我们在某项目的考勤核查中发现，存在员工通过他人手机登录钉钉进行虚假定位打卡
的违规情况。经深入调查，该问题已得到证实。

在处理相关违纪员工的同时，我们意识到集团拥有 7000 余名在职员工，此类作弊行为存在
的风险较高。因此，决定对全部员工的原始打卡记录展开全面审计。

![使用 Excel VBA 高效审计钉钉打卡记录，快速识别代打卡行为](https://blog.guohao.asia/
wp-content/themes/wordpress-theme-puock-2.8.16/assets/img/z/load.svg "使用 Excel
VBA 高效审计钉钉打卡记录，快速识别代打卡行为")

每月 7000 名员工产生的打卡记录接近 20 万条，数据量庞大，人工核对几乎不可行。通过
分析代打卡行为的业务逻辑，我们发现：如果单一设备编码（手机硬件标识）对应多个不同
的员工账号，即可判定存在代打卡嫌疑。

基于这一规律，开发了以下 Excel VBA 解决方案，实现快速、自动化的审计流程：

    ```language-default
    Sub FindMultiUserDevices()
        ' 声明变量
        Dim wsSource As Worksheet, wsResult As Worksheet
        Dim dict As Object ' 用于存储设备号和对应的员工集合
        Dim lastRow As Long, i As Long
        Dim deviceID As String, employeeName As String
        Dim key As Variant, empKey As Variant
        Dim outputRow As Long
        Dim nameList As String

        ' 设置源数据工作表 (假设数据在原始记录)
        On Error Resume Next
        Set wsSource = ThisWorkbook.Worksheets("原始记录")
        On Error GoTo 0

        If wsSource Is Nothing Then
            MsgBox "找不到工作表' 原始记录 '，请修改代码中的工作表名称。", vbExclamation
            Exit Sub
        End If

        ' 创建或清空结果工作表
        Application.DisplayAlerts = False
        On Error Resume Next
        ThisWorkbook.Worksheets("异常设备报告").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True

        Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsResult.Name = "异常设备报告"

        ' 在结果表创建标题
        With wsResult
            .Range("A1").Value = "设备编号"
            .Range("B1").Value = "使用员工数量"
            .Range("C1").Value = "使用员工名单"
            .Range("A1:C1").Font.Bold = True
            .Columns("A:C").AutoFit
        End With

        outputRow = 2 '从第 2 行开始输出结果' 创建字典对象来存储数据
        Set dict = CreateObject("Scripting.Dictionary")

        ' 找出源数据的最后一行 (使用 P 列确定行数)
        lastRow = wsSource.Cells(wsSource.Rows.Count, "P").End(xlUp).Row

        ' 检查是否有数据
        If lastRow < 2 Then
            wsResult.Cells(2, 1).Value = "源数据表中没有找到有效数据。"
            wsResult.Columns("A:C").AutoFit
            wsResult.Activate
            Exit Sub
        End If

        ' 遍历所有数据行 (假设第 1 行是标题，从第 2 行开始)
        For i = 2 To lastRow
            On Error Resume Next ' 防止类型转换错误
            deviceID = Trim(CStr(wsSource.Cells(i, "P").Value)) ' P 列是设备号
            employeeName = Trim(CStr(wsSource.Cells(i, "A").Value)) ' A 列是员工姓名
            On Error GoTo 0

            ' 跳过空设备号或空姓名的行
            If deviceID = ""Or employeeName ="" Then GoTo NextRow

            ' 如果字典中没有这个设备号，则添加一个新集合
            If Not dict.Exists(deviceID) Then
                dict.Add deviceID, CreateObject("Scripting.Dictionary")
            End If

            ' 将员工姓名添加到该设备号对应的集合中
            If Not dict(deviceID).Exists(employeeName) Then
                dict(deviceID).Add employeeName, Nothing
            End If

    NextRow:
        Next i

        ' 遍历字典，找出使用员工数 > 1 的设备
        For Each key In dict.Keys
            If dict(key).Count > 1 Then
                ' 输出到结果表
                wsResult.Cells(outputRow, 1).Value = key ' 设备号
                wsResult.Cells(outputRow, 2).Value = dict(key).Count '员工数量' 将员工姓名集合连接成一个字符串，用逗号隔开
                nameList = ""
                For Each empKey In dict(key).Keys
                    nameList = nameList & empKey & ","
                Next empKey

                ' 去掉最后一个逗号和空格
                If Len(nameList) > 0 Then
                    nameList = Left(nameList, Len(nameList) - 2)
                End If

                wsResult.Cells(outputRow, 3).Value = nameList ' 员工名单
                outputRow = outputRow + 1
            End If
        Next key

        ' 如果没有找到异常设备，提示用户
        If outputRow = 2 Then
            wsResult.Cells(2, 1).Value = "未发现一个设备对应多个员工的情况。"
        Else
            ' 对结果表进行排序（按员工数量降序）With wsResult
                If outputRow > 2 Then
                    .Range("A1:C" & outputRow - 1).Sort Key1:=.Range("B2"), Order1:=xlDescending, Header:=xlYes
                End If
            End With
        End If

        ' 自动调整列宽
        wsResult.Columns("A:C").AutoFit
        wsResult.Activate ' 切换到结果工作表

        MsgBox "分析完成！共找到" & (outputRow - 2) & "个异常设备。结果已输出到工作表【异常设备报告】。", vbInformation
    End Sub
    ```

实际运行结果如下图：

![使用 Excel VBA 高效审计钉钉打卡记录，快速识别代打卡行为](https://blog.guohao.asia/
wp-content/themes/wordpress-theme-puock-2.8.16/assets/img/z/load.svg "使用 Excel
VBA 高效审计钉钉打卡记录，快速识别代打卡行为")