VBA 根据飞书导出的考勤记录生成对应的考勤记录汇总表

最新推荐文章于 2024-09-27 19:46:50 发布

码猩

最新推荐文章于 2024-09-27 19:46:50 发布

阅读量398

点赞数 4

分类专栏： excelVBA专栏文章标签：飞书 android javascript VBA

本文链接：https://blog.csdn.net/weixin_43050480/article/details/141299777

版权

excelVBA专栏专栏收录该内容

54 篇文章 6 订阅

订阅专栏

VBA 根据飞书导出的考勤记录生成对应的考勤记录汇总表

Sub 一键生成考勤数据()
Dim pathA As String
Dim pathB As String
Dim pathC As String
Dim pathD As String
Dim path As String

Dim newPath As String
Dim newFileName As String
Dim fso As Object
 ' 创建FileSystemObject实例
Set fso = CreateObject("Scripting.FileSystemObject")

pathA = ThisWorkbook.path & "\考勤汇总表模板\考勤汇总表模板.xlsx"

pathB = ThisWorkbook.path & "\考勤数据\"
pathB = ThisWorkbook.path & "\考勤数据\" & Dir(pathB) '月度汇总表


pathC = ThisWorkbook.path & "\上月考勤汇总表\"
pathC = ThisWorkbook.path & "\上月考勤汇总表\" & Dir(pathC) '上月考勤表汇总数据



newPath = ThisWorkbook.path & "\生成当月的考勤数据\"
newFileName = ThisWorkbook.Worksheets(1).Range("A2") & "考勤汇总表.xlsx"
path = newPath & newFileName


' 确保路径存在
    If Not fso.FolderExists(newPath) Then
        MsgBox "指定的路径不存在！", vbExclamation
        Exit Sub
    End If
 ' 复制文件
    FileCopy pathA, path
    
  Set fso = Nothing
  
Dim wbt As Workbook '程序工作表
Dim sht As Worksheet
Dim wbk As Workbook '考勤工作表
Dim shk As Worksheet
Dim wby As Workbook '月度汇总工作表
Dim shy As Worksheet

Set wbt = ThisWorkbook
Set sht = ThisWorkbook.Worksheets(1)

Set wbk = Workbooks.Open(path)
Set shk = wbk.Worksheets(1)
Dim yzcdsum As Double

Dim chdao As Double

For i = 4 To 2000
    If Trim(shk.Cells(i, 2)) <> "" Then
        shk.Cells(i, 1) = sht.Range("A2")
        shk.Cells(i, 6) = sht.Range("B2")
    ElseIf Trim(shk.Cells(i, 2)) = "" Then
    Exit For
    End If
Next i
i = 0
Set wby = Workbooks.Open(pathB)
Set shy = wby.Worksheets(1)

For i = 4 To 2000
    If Trim(shk.Cells(i, 3)) <> "" Then
        For j = 3 To 2000
            If Trim(shk.Cells(i, 3)) = Trim(shy.Cells(j, 1)) Then '名字相等
                
                Trim(shk.Cells(i, 9)) = Trim(shy.Cells(j, 26)) '事假
                Trim(shk.Cells(i, 10)) = Trim(shy.Cells(j, 29)) '病假
                If CDbl(Trim(shy.Cells(j, 19))) = 0 And CDbl(Trim(sht.Cells(i, 14))) > 0 And CDbl(Trim(shy.Cells(j, 17))) = 0 Then '没有迟到和严重迟到
                    Trim(shk.Cells(i, 10)) = Trim(shy.Cells(j, 17)) '迟到时长，严重迟到时长都为0
                ElseIf CDbl(Trim(shy.Cells(j, 19))) = 0 And CDbl(Trim(sht.Cells(i, 14))) >= 0 And CDbl(Trim(shy.Cells(j, 17))) > 0 Then '有迟到没有严重迟到
                        chdao = 0 '计算迟到是否排除了免迟到
                        For m = 70 To 200
                            If Trim(shy.Cells(j, m)) <> "" Then
                                    cda = "迟到"
                                    strword = "严重迟到"
                                    strzif = Trim(shy.Cells(j, m))
                                    If (ContainsWord(strzif, strword) = False) And ContainsWord(strzif, cda) Then
                                        reslut = Split(strzif, "分")
                                        rel = Split(reslut(0), "到")
                                        If CDbl(rel(1)) <= 6 And CDbl(Trim(sht.Cells(i, 14))) > 0 Then
                                            sht.Cells(i, 14) = CDbl(Trim(sht.Cells(i, 14))) - 1
                                        ElseIf CDbl(rel(1)) > 6 And CDbl(Trim(sht.Cells(i, 14))) > 0 Then
                                            chdao = chdao + CDbl(rel(1))
                                        ElseIf CDbl(rel(1)) > 0 And CDbl(Trim(sht.Cells(i, 14))) = 0 Then
                                            chdao = chdao + CDbl(rel(1))
                                        End
                                    End If
                            
                        
                
                ElseIf CDbl(Trim(shy.Cells(j, 19))) > 0 And CDbl(Trim(sht.Cells(i, 14))) = 0 And CDbl(Trim(shy.Cells(j, 17))) = 0 Then '有严重迟到，没有迟到
                    '判断异常数据
                    '统计严重迟到分钟数据
                    yzcdsum = 0 '分钟
                    For m = 70 To 200
                        If Trim(shy.Cells(j, m)) <> "" Then
                            strword = "严重迟到"
                            strzif = Trim(shy.Cells(j, m))
                            xqj = Trim(shy.Cells(2, m))
                           If ContainsWord(strzif, strword) And (ContainsWord(strzif, "外出") = False) And (ContainsWord(xqj, "星期一") = False) Then '严重迟到不是周五加班很晚的情况
                                reslut = Split(strzif, "分")
                                rel = Split(reslut(0), "到")
                                yzcdsum = yzcdsum + CDbl(rel(1))
                           ElseIf ContainsWord(strzif, strword) And (ContainsWord(strzif, "外出") = False) And (ContainsWord(xqj, "星期一") = True) Then '判定周五的下班时间是否是22点后
                                '如果是周五22点下班就不计入，如果不是就需要计入
                           End If
                            
                        
                        Else
                        Exit For
                        End If
                    Next m
                    'Trim(shk.Cells(i, 10)) = CDbl(Trim(shy.Cells(j, 17))) + (yzcdsum / 60) '兑换小时后和迟到小时相加
                End If
                
                
            End If
            
        Next j
    
    ElseIf Trim(shk.Cells(i, 3)) = "" Then
    Exit For
    End If
Next i
    
    


End Sub
Function ContainsWord(str As String, word As String) As Boolean
    ContainsWord = InStr(1, str, word, vbTextCompare) > 0
End Function