考勤统计拿去直接用

记录本次的目的：
1、代码拿来就能用
2、各人记录下，因为里面有些vb的语法有可能我以后会查看。（本人写vb本来就是为了简化工作，所以很多语法都是在网上查的不懂什么意思，只会用，有的地方我自己都觉得用的不太好，但是就是能实现功能。所以记录，方便以后查看）

统计员工每月上班时长

通过excel计算每个员工每个月上班小时数
后台导出数据格式如下。员工一天可能多次打卡，举例中午下班时打卡一次，吃完中饭后又打一次，所以打卡次数可能多次。多次打卡时间以逗号隔开。如果只打卡一次本程序是不计算时间的，直接忽略该条数据
注意：基础数据的格式必须与我保持一致，其中一致包括sheet名称必须是基础数据，打卡时间必须以逗号隔开，数据应该从第七行开始。
运行结果
会产生1到12月份的sheet和一个汇总的sheet，每个月的sheet中展示每个员工该月份上班时长

汇总中把每个员工1-12月的数据汇集在一起，方便操作人制作汇报的图标（没研究那么深所以，不知道vb是否能做图表。但是个人认为应该是可以的，如果有需要可以自行去研究）

代码

怎么说呢，自己写的时候就觉得很烂，各种循环各种判断，然后在网上找了个删除重复的方法，无意发现sub可以调用sub。其实早想到，只是懒得去验证。算了我觉得还是整理**释吧，因为写这个功能的时候我只关注结果，所以代码有点不好看。我都懒得读，加注释了。

Sub sumTime()
    Application.DisplayAlerts = False
    Dim month As Integer
    month = 1
    '删除上一次操作留下来的数据
    For Each del12sht In Sheets
        If del12sht.name = "1月份" Or del12sht.name = "2月份" Or del12sht.name = "3月份" Or del12sht.name = "4月份" Or del12sht.name = "5月份" Or del12sht.name = "6月份" Or del12sht.name = "7月份" Or del12sht.name = "8月份" Or del12sht.name = "9月份" Or del12sht.name = "10月份" Or del12sht.name = "11月份" Or del12sht.name = "12月份" Or del12sht.name = "汇总" Then
        del12sht.Delete
        End If
        month = month + 1
    Next
    
    Dim sht1 As Worksheet
    Set sht1 = Worksheets(Sheet1) '获取sheet1
    Dim sht2 As Worksheet
    
    '判断中间表的sheet是否存在,存在就删除
    For Each delSheet In Sheets
        If delSheet.name = "中间表" Then
        delSheet.Delete
        End If
    Next
    
    Set sht2 = Worksheets.Add
    sht2.name = "中间表"
    
    '-----------------以上新增sheet保存结果
    sht2.Range("A1").Value = "序号"
    sht2.Range("B1").Value = "姓名"
    sht2.Range("C1").Value = "月份"
    sht2.Range("D1").Value = "工时"
    
    '获取姓名
    Dim emptySht As Worksheet
    Set emptySht = Worksheets.Add
    emptySht.name = "临时表"
    sht1.Copy before:=emptySht
    '删除重复的名字,得到所有员工姓名
    delDouble ("基础数据 (2)")
    
    Worksheets("基础数据 (2)").Range("C7:C10007").Copy Destination:=Worksheets("中间表").Range("B2:B10002")
    Worksheets("基础数据 (2)").Delete
    
    
    '统计
    Dim maxRowNum As Integer
    maxRowNum = Worksheets("中间表").UsedRange.Rows.Count
    For J = 1 To 12
    Worksheets("中间表").Copy before:=emptySht
    Next
    Worksheets("临时表").Delete
    Worksheets("中间表").Delete
    
    '创建每个月份的sheet
    Worksheets("中间表 (2)").name = "1月份"
    Worksheets("中间表 (3)").name = "2月份"
    Worksheets("中间表 (4)").name = "3月份"
    Worksheets("中间表 (5)").name = "4月份"
    Worksheets("中间表 (6)").name = "5月份"
    Worksheets("中间表 (7)").name = "6月份"
    Worksheets("中间表 (8)").name = "7月份"
    Worksheets("中间表 (9)").name = "8月份"
    Worksheets("中间表 (10)").name = "9月份"
    Worksheets("中间表 (11)").name = "10月份"
    Worksheets("中间表 (12)").name = "11月份"
    Worksheets("中间表 (13)").name = "12月份"
    
    '每个sheet中填入月份的数据
    For K = 1 To 12
        Dim str As String
        str = K & "月份"
        Worksheets(str).Range("C2:C" & maxRowNum).NumberFormat = "@"
    
        If K <= 9 Then
            Worksheets(str).Range("C2:C" & maxRowNum) = "0" & K
        Else
            Worksheets(str).Range("C2:C" & maxRowNum) = K
        End If
        For L = 2 To maxRowNum
            Worksheets(str).Cells(L, 1) = L - 1
        Next
    Next
    
    Dim emp2 As Worksheet
    Set emp2 = Worksheets.Add
    emp2.name = "临时表2"
    
    emp2.Range("A1").Value = "姓名"
    emp2.Range("B1").Value = "日期"
    emp2.Range("C1").Value = "月份"
    emp2.Range("D1").Value = "时间"
    
    Worksheets("基础数据").Range("C7:C10007").Copy Destination:=Worksheets("临时表2").Range("A2:A10002")
    Worksheets("基础数据").Range("D7:D10007").Copy Destination:=Worksheets("临时表2").Range("B2:B10002")
    Worksheets("临时表2").Range("C2:C10002").NumberFormat = "@"
    
    For r = 2 To 10007
        If Range("B" & r) <> "" Then
            emp2.Range("C" & r) = Mid$(Range("B" & r).Value, 6, 2)
        End If
    Next
    
    Worksheets("基础数据").Activate
    Dim arr() As String
    Dim str1 As String
    Dim str2 As String
    Dim num As Integer
    For t = 7 To 10007
        If Range("F" & t) <> "" Then
            num = Range("E" & t).Value
            If num > 1 Then
                str1 = Range("F" & t).Value
                Worksheets("临时表2").Range("E" & t - 5).Value = str1
            
            End If
        End If
    Next
    Dim strEnd As Date
    Dim strStart As Date
    Worksheets("临时表2").Activate
    For u = 2 To 10007
        If Range("E" & u) <> "" Then
        str2 = Worksheets("临时表2").Range("E" & u).Value
        arr = Split(str2, ",")
        strEnd = CDate(arr(UBound(arr) - 1))
        strStart = CDate(arr(LBound(arr)))
    
        d1 = DateDiff("s", strStart, strEnd) / 60 / 60
        Worksheets("临时表2").Range("D" & u).Value = d1
        
        End If
    Next
    
    '-----以上基础数据准备完事
    
    For o = 1 To 12 '循环sheet
        For p = 2 To 10007 '循环行
            If Worksheets(o & "月份").Range("B" & p) <> "" Then
                Worksheets("临时表2").Activate
                Dim strName As String: strName = Worksheets(o & "月份").Range("B" & p)
                Dim strMonth As String: strMonth = Worksheets(o & "月份").Range("C" & p)
                Worksheets("临时表2").Activate
                Dim timeSum As Long: timeSum = 0
                For B = 2 To 10007
                    If Worksheets("临时表2").Range("A" & B) = strName And Worksheets("临时表2").Range("C" & B) = strMonth Then
                        timeSum = timeSum + Worksheets("临时表2").Range("D" & B)
                    End If
                Next
                Worksheets(o & "月份").Activate
                Worksheets(o & "月份").Range("D" & p) = timeSum
            End If
        Next
    
    Next

    Worksheets("临时表2").Delete
    Application.DisplayAlerts = True
    
    '-------汇总
    Dim totalSht As Worksheet
    Set totalSht = Worksheets.Add
    totalSht.name = "汇总"
    Worksheets("汇总").Range("A1").Value = 序号
    Worksheets("汇总").Range("B1").Value = 姓名
    
    Worksheets("1月份").Range("A2:B10007").Copy Destination:=Worksheets("汇总").Range("A2:B10002")
    For m = 1 To 12
        Worksheets("汇总").Cells(1, m + 2).Value = m & "月份"
    Next
    For n = 1 To 12
        Worksheets(n & "月份").Range("D2:D100").Copy Destination:=Worksheets("汇总").Range(Cells(2, n + 2), Cells(100, n + 2))
    Next
    
    
    

End Sub
'删除col列的重复数据
Sub delDouble(str)
    '本例是删除标题为sheet1的EXCEL表中A列（从A2单元格开始）的重复数据
    Application.ScreenUpdating = False
    '可根据实际情况修改下面三行的结尾值
    Dim sheetsCaption As String: sheetsCaption = str
    Dim Col As String: Col = "C"
    Dim StartRow As Integer: StartRow = 7
    '以下不需要修改
    Dim EndRow As Integer: EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row
    Dim Count_1 As Integer: Count_1 = 0
    Dim count_2 As Integer: count_2 = 0
    Dim i As Integer: i = StartRow
    With Sheets(sheetsCaption)
    Do
    Count_1 = Count_1 + 1
    For J = StartRow To i - 1
        If .Range(Col & i) = .Range(Col & J) Then
            Count_1 = Count_1 - 1
            .Range(Col & i).EntireRow.Delete
            EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row
            i = i - 1
            count_2 = count_2 + 1
        Exit For
        End If
    Next
    i = i + 1
    Loop While i < EndRow + 1
    End With
    Application.ScreenUpdating = True
End Sub