# 使用ExcelVBA审计钉钉原始打卡记录(代码优化)

- 连结：https://blog.guohao.asia/%e4%bd%bf%e7%94%a8excelvba%e5%ae%a1%e8%ae%a1%e9%92%89%e9%92%89%e5%8e%9f%e5%a7%8b%e6%89%93%e5%8d%a1%e8%ae%b0%e5%bd%95%e4%bb%a3%e7%a0%81%e4%bc%98%e5%8c%96.html
- 发布时间：2025-08-30T10:07:32+08:00
- 作者：null

来自 AI 助手的总结

该 VBA 宏用于分析考勤数据，检测多员工共用设备并生成异常报告。

中文   英文   韩语   日语

    ```language-default
    Sub FindMultiUserDevicesWithCount()
        ' 声明变量
        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("D1").Value = "设备持有人"
            .Range("E1").Value = "代打卡员工"
            .Range("A1:E1").Font.Bold = True
            .Columns("A:E").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:E").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

            ' 如果该设备号的字典中没有这个员工，则添加并初始化计数为 1
            If Not dict(deviceID).Exists(employeeName) Then
                dict(deviceID).Add employeeName, 1
            Else
                ' 如果已存在，则计数加 1
                dict(deviceID)(employeeName) = dict(deviceID)(employeeName) + 1
            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 & "(" & dict(key)(empKey) & "次),"
                Next empKey

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

                wsResult.Cells(outputRow, 3).Value = nameList '员工名单及打卡次数' 新增功能：识别设备持有人和代打卡员工
                Dim maxCount As Long
                Dim holder As String
                Dim proxyEmployees As String

                ' 找出打卡次数最多的员工
                maxCount = 0
                holder = ""
                For Each empKey In dict(key).Keys
                    If dict(key)(empKey) > maxCount Then
                        maxCount = dict(key)(empKey)
                        holder = empKey
                    End If
                Next

                ' 构建代打卡员工名单（包含打卡次数）proxyEmployees = ""
                For Each empKey In dict(key).Keys
                    If empKey <> holder Then
                        proxyEmployees = proxyEmployees & empKey & "(" & dict(key)(empKey) & "次),"
                    End If
                Next

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

                ' 写入持有人和代打卡员工信息
                wsResult.Cells(outputRow, 4).Value = holder & "(" & maxCount & "次)"
                wsResult.Cells(outputRow, 5).Value = proxyEmployees

                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:E" & outputRow - 1).Sort Key1:=.Range("B2"), Order1:=xlDescending, Header:=xlYes
                End If
            End With
        End If

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

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

### 主要功能：

 * **数据源处理**：从名为“原始记录”的工作表中读取数据，其中设备编号位于 P 列，员工
   姓名位于 A 列。
 * **数据统计**：使用字典对象高效地统计每个设备编号对应的员工及其打卡次数。
 * **报告生成**：创建一个名为“异常设备报告”的新工作表，列出所有异常设备（即被多个
   员工使用的设备），包括以下信息：
 * **设备编号**：设备的唯一标识。
 * **使用员工数量**：使用该设备的员工总数。
 * **使用员工名单及打卡次数**：列出所有使用该设备的员工姓名及其打卡次数（例如：张三(
   5 次), 李四(3 次)）。
 * **设备持有人**：打卡次数最多的员工（被视为主要使用者）。
 * **代打卡员工**：其他使用该设备的员工（可能涉及代打卡行为）。
 * **排序和格式化**：报告按员工数量降序排序，并自动调整列宽以便阅读。
 * **用户反馈**：运行完成后，显示消息框提示找到的异常设备数量。

### 适用场景：

 * 企业考勤系统分析，检测异常打卡行为。
 * 设备使用审计，确保设备分配合规。
 * 人力资源或安全管理，防止代打卡或未授权设备使用。

### 如何使用：

 1. 确保 Excel 工作簿中有一个名为“原始记录”的工作表，且包含员工姓名（A 列）和设备编号（
    P 列）数据。
 2. 在 Excel 中运行此宏（通过 VBA 编辑器或按钮触发）。
 3. 宏将自动生成“异常设备报告”工作表，并提供分析结果。