Sub main1()
'MsgBox day(DateSerial(2018, 3, 0))
MainForm.Show
End Sub
Public Function AnalysisAttendance(dayfliter As String)
Dim MyTime As Date
Dim D, KqData
Dim i
Dim s As String
Dim tmp
Dim arrdata(1 To 10000, 1 To 10)
Dim startTime As String
Dim endtime As String
Dim days As Integer
Dim nameno As String
Dim CurNameno As String
Const ColumnIndexName = 2
Const ColumnIndexNo = 3
Const ColumnIndexKQT = 4
Dim temp() As String
Dim Date1 As Date
Dim Date2 As Date
Set D = CreateObject("scripting.dictionary")
KqData = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:D"))
For i = 2 To UBound(KqData, 1)
CurNameno = KqData(i, ColumnIndexName) & Format(KqData(i, ColumnIndexNo))
If nameno <> CurNameno Then
days = day(DateSerial(Year(Format(KqData(i, ColumnIndexKQT), "yyyy-mm-dd")), Month(Format(KqData(i, ColumnIndexKQT), "yyyy-mm-dd")) + 1, 0))
nameno = CurNameno
For ID = 1 To days
If SG_InArray(dayfliter, ID) = False Then
s = "'" & KqData(i, ColumnIndexName) & Format(KqData(i, ColumnIndexNo)) & Format(KqData(i, ColumnIndexKQT), "yyyy-mm-") + Format(ID, "00")
If Not D.exists(s) Then
D(s) = ""
Else
D(s) = ""
End If
End If
Next ID
End If
s = "'" & KqData(i, ColumnIndexName) & Format(KqData(i, ColumnIndexNo)) & Format(KqData(i, ColumnIndexKQT), "yyyy-mm-dd")
' If Not D.exists(s) Then
'D(s) = Format(KqData(i, ColumnIndexKQT), "hh:mm:ss")
'Else
'D(s) = D(s) & Space(1) & Format(KqData(i, ColumnIndexKQT), "hh:mm:ss")
'End If
If Not D.exists(s) Or D(s) = "" Then
D(s) = Format(KqData(i, ColumnIndexKQT), "hh:mm:ss")
Else
D(s) = D(s) & Space(1) & Format(KqData(i, ColumnIndexKQT), "hh:mm:ss")
End If
Next i
tmp = Application.Transpose(Array(D.keys, D.items))
arrdata(1, 1) = "姓名+工号"
arrdata(1, 2) = "日期"
arrdata(1, 3) = "上午打开时间"
arrdata(1, 4) = "下午打开时间"
arrdata(1, 5) = "上午迟到"
arrdata(1, 6) = "下午早退"
arrdata(1, 7) = "累计上班时长"
For i = 1 To UBound(tmp, 1)
arrdata(i + 1, 1) = Mid(tmp(i, 1), 1, Len(tmp(i, 1)) - 10)
arrdata(i + 1, 2) = "'" & Right(tmp(i, 1), 10)
'arrdata(i, 3) = tmp(i, 2)
temp = Split(tmp(i, 2), Space(1))
Dim stra As String
arrdata(i + 1, 3) = SG_GetFirst(tmp(i, 2), Space(1))
arrdata(i + 1, 4) = SG_GetLast(tmp(i, 2), Space(1))
If arrdata(i + 1, 3) = "" And arrdata(i + 1, 4) <> "" Then
If SG_Compare(arrdata(i + 1, 4)) = "上午" Then
arrdata(i + 1, 3) = arrdata(i + 1, 4)
arrdata(i + 1, 4) = ""
End If
End If
If arrdata(i + 1, 4) = "" And arrdata(i + 1, 3) <> "" Then
If SG_Compare(arrdata(i + 1, 3)) = "下午" Then
arrdata(i + 1, 4) = arrdata(i + 1, 3)
arrdata(i + 1, 3) = ""
End If
End If
arrdata(i + 1, 5) = SG_DiffTime(arrdata(i + 1, 3), "09:00:00")
arrdata(i + 1, 6) = SG_DiffTime("18:30:00", arrdata(i + 1, 4))
arrdata(i + 1, 7) = SG_DiffTime(arrdata(i + 1, 3), arrdata(i + 1, 4))
' arrdata(i, 4) = SG_GetLast(tmp(i, 2), Space(1))
Next i
ActiveSheet.[E1].Resize(D.Count, 7) = arrdata '根据实际需要设置数据位置
SG_Statistics tmp, arrdata
End Function
Public Function SG_Statistics(ByVal temp, ByVal arrdata)
Dim nameno As String
Dim CurNameno As String
Dim cidaocount As Integer
Dim cidaosrting As String
Dim zaotuicount As Integer
Dim zaotuisrting As String
Dim queqingCount As Integer
Dim queqingString As String
Dim amdkCount As Integer
Dim amdkString As String
Dim pmdkCount As Integer
Dim pmdkString As String
Dim arrdataStatistics(1 To 200, 1 To 11)
Dim D
Dim tmpx
Set D = CreateObject("scripting.dictionary")
nameno = ""
For i = 2 To UBound(temp, 1) + 1
CurNameno = arrdata(i, 1)
If nameno <> CurNameno Then
If nameno <> "" Then
If Not D.exists(nameno) Or D(nameno) = "" Then
If zaotuisrting = "" Then
zaotuisrting = "none"
End If
If cidaosrting = "" Then
cidaosrting = "none"
End If
If queqingString = "" Then
queqingString = "none"
End If
If amdkString = "" Then
amdkString = "none"
End If
If pmdkString = "" Then
pmdkString = "none"
End If
D(nameno) = cidaocount & "=" & cidaosrting & "=" & zaotuicount & "="
D(nameno) = D(nameno) & zaotuisrting & "=" & queqingCount & "=" & queqingString & "=" & amdkCount & "=" & amdkString & "=" & pmdkCount & "=" & pmdkString
Else
D(nameno) = cidaocount & "=" & cidaosrting & "=" & zaotuicount & "="
D(nameno) = D(nameno) & zaotuisrting & "=" & queqingCount & "=" & queqingString & "=" & amdkCount & "=" & amdkString & "=" & pmdkCount & "=" & pmdkString
End If
End If
nameno = CurNameno
cidaocount = 0
cidaosrting = ""
zaotuicount = 0
zaotuisrting = ""
queqingCount = 0
queqingString = ""
amdkCount = 0
amdkString = ""
pmdkCount = 0
pmdkString = ""
End If
If InStr(arrdata(i, 5), "-") > 0 Then
cidaocount = cidaocount + 1
cidaosrting = cidaosrting & arrdata(i, 2) & " " & arrdata(i, 3) & "、"
End If
If InStr(arrdata(i, 6), "-") > 0 Then
zaotuicount = zaotuicount + 1
zaotuisrting = zaotuisrting & arrdata(i, 2) & " " & arrdata(i, 4) & "、"
End If
If arrdata(i, 3) = "" And arrdata(i, 4) <> "" Then
amdkCount = amdkCount + 1
amdkString = amdkString & arrdata(i, 2) & "、"
End If
If arrdata(i, 3) <> "" And arrdata(i, 4) = "" Then
pmdkCount = pmdkCount + 1
pmdkString = pmdkString & arrdata(i, 2) & "、"
End If
If arrdata(i, 3) = "" Or arrdata(i, 4) = "" Then
queqingCount = queqingCount + 1
queqingString = queqingString & arrdata(i, 2) & "、"
End If
Next i
If nameno <> "" Then
If Not D.exists(nameno) Or D(nameno) = "" Then
D(nameno) = cidaocount & "=" & cidaosrting & "=" & zaotuicount & "="
D(nameno) = D(nameno) & zaotuisrting & "=" & queqingCount & "=" & queqingString & "=" & amdkCount & "=" & amdkString & "=" & pmdkCount & "=" & pmdkString
Else
D(nameno) = cidaocount & "=" & cidaosrting & "=" & zaotuicount & "="
D(nameno) = D(nameno) & zaotuisrting & "=" & queqingCount & "=" & queqingString & "=" & amdkCount & "=" & amdkString & "=" & pmdkCount & "=" & pmdkString
End If
End If
tmpx = Application.Transpose(Array(D.keys, D.items))
arrdata(1, 1) = "姓名+工号"
arrdataStatistics(1, 2) = "迟到次数"
arrdataStatistics(1, 3) = "迟到信息"
arrdataStatistics(1, 4) = "早退次数"
arrdataStatistics(1, 5) = "早退信息"
arrdataStatistics(1, 6) = "缺勤次数"
arrdataStatistics(1, 7) = "缺勤信息"
arrdataStatistics(1, 8) = "上午没打卡次数"
arrdataStatistics(1, 9) = "上午没打卡信息"
arrdataStatistics(1, 10) = "下午没打卡次数"
arrdataStatistics(1, 11) = "下午没打卡信息"
For i = 1 To UBound(tmpx, 1)
arrdataStatistics(i + 1, 1) = tmpx(i, 1)
arrdataStatistics(i + 1, 2) = SG_GetSub(tmpx(i, 2), "=", 0)
arrdataStatistics(i + 1, 3) = SG_GetSub(tmpx(i, 2), "=", 1)
arrdataStatistics(i + 1, 4) = SG_GetSub(tmpx(i, 2), "=", 2)
arrdataStatistics(i + 1, 5) = SG_GetSub(tmpx(i, 2), "=", 3)
arrdataStatistics(i + 1, 6) = SG_GetSub(tmpx(i, 2), "=", 4)
arrdataStatistics(i + 1, 7) = SG_GetSub(tmpx(i, 2), "=", 5)
arrdataStatistics(i + 1, 8) = SG_GetSub(tmpx(i, 2), "=", 6)
arrdataStatistics(i + 1, 9) = SG_GetSub(tmpx(i, 2), "=", 7)
arrdataStatistics(i + 1, 10) = SG_GetSub(tmpx(i, 2), "=", 8)
arrdataStatistics(i + 1, 11) = SG_GetSub(tmpx(i, 2), "=", 9)
Next i
ActiveSheet.[L1].Resize(D.Count, 11) = arrdataStatistics '根据实际需要设置数据位置
End Function
Public Function SG_InArray(ByVal tmp As String, ByVal va As String)
Dim temp() As String
temp = Split(tmp, ",")
For i = 0 To UBound(temp) - LBound(temp)
If temp(i) = va Then
GoTo a
End If
Next i
GoTo b
a:
SG_InArray = True
GoTo ed
b:
SG_InArray = False
ed:
End Function
Public Function SG_DiffTime(ByVal time1 As String, ByVal time2 As String)
Dim SS As Long
Dim temp() As String
If time1 <> "" And time2 <> "" Then
Date1 = Format(time1, "hh:mm:ss")
Date2 = Format(time2, "hh:mm:ss")
SS = DateDiff("s", Date1, Date2)
If SS >= 0 Then
SG_DiffTime = (SS \ 3600) & ":" & ((SS Mod 3600) \ 60) & ":" & (SS Mod 60)
Else
SG_DiffTime = "- " & (-SS \ 3600) & ":" & ((-SS Mod 3600) \ 60) & ":" & (-SS Mod 60)
End If
End If
End Function
Public Function SG_DiffTime2(ByVal time1 As String, ByVal time2 As String)
Dim SS As Long
Dim temp() As String
If time1 <> "" And time2 <> "" Then
Date1 = Format(time1, "hh:mm:ss")
Date2 = Format(time2, "hh:mm:ss")
SS = DateDiff("s", Date1, Date2)
If SS >= 0 Then
SG_DiffTime2 = "- " & (SS \ 3600) & ":" & ((SS Mod 3600) \ 60) & ":" & (SS Mod 60)
Else
SG_DiffTime2 = (-SS \ 3600) & ":" & ((-SS Mod 3600) \ 60) & ":" & (-SS Mod 60)
End If
End If
End Function
Public Function SG_Compare(ByVal time1 As String)
Dim SS As Long
Dim temp() As String
If time1 <> "" Then
Date1 = Format(time1, "hh:mm:ss")
Date2 = Format("12:00:00", "hh:mm:ss")
SS = DateDiff("s", Date1, Date2)
If SS >= 0 Then
SG_Compare = "上午"
Else
SG_Compare = "下午"
End If
Else
End If
End Function
Public Function SG_GetSub(ByVal tmp As String, ByVal splitstr, ByVal index As Integer)
Dim temp() As String
temp = Split(tmp, splitstr)
If UBound(temp) - LBound(temp) + 1 > index Then
SG_GetSub = temp(index)
Else
SG_GetSub = ""
End If
End Function
Public Function SG_GetFirst(ByVal tmp As String, ByVal splitstr)
Dim temp() As String
temp = Split(tmp, splitstr)
If UBound(temp) - LBound(temp) + 1 > 0 Then
SG_GetFirst = temp(0)
Else
SG_GetFirst = ""
End If
End Function
Public Function SG_GetLast(ByVal tmp As String, ByVal splitstr)
Dim temp() As String
temp = Split(tmp, splitstr)
If UBound(temp) - LBound(temp) + 1 > 1 Then
SG_GetLast = temp(UBound(temp) - LBound(temp))
Else
SG_GetLast = ""
End If
End Function
Excel例子
部门 |
姓名 |
工号 |
日期时间 |
总公司 |
藏阿加 |
38 |
2017/5/5 18:43 |
总公司 |
藏阿加 |
38 |
2017-5-6 8:49:04 |
总公司 |
藏阿加 |
38 |
2017-5-6 16:41:55 |
总公司 |
藏阿加 |
38 |
2017-5-8 8:56:16 |
总公司 |
藏阿加 |
38 |
2017-5-8 18:52:52 |
总公司 |
藏阿加 |
38 |
2017/5/9 8:45 |
总公司 |
藏阿加 |
38 |
2017-5-9 18:47:56 |
总公司 |
藏阿加 |
38 |
2017-5-10 8:54:24 |
总公司 |
藏阿加 |
38 |
2017-5-10 18:38:29 |
总公司 |
藏阿加 |
38 |
2017-5-11 18:50:18 |
总公司 |
藏阿加 |
38 |
2017-5-12 8:50:29 |
总公司 |
藏阿加 |
38 |
2017-5-12 18:44:59 |
总公司 |
秋季换 |
80 |
2017-5-2 8:56:13 |
总公司 |
秋季换 |
80 |
2017-5-2 18:32:45 |
总公司 |
秋季换 |
80 |
2017-5-3 8:53:43 |
总公司 |
秋季换 |
80 |
2017-5-3 18:33:05 |
总公司 |
秋季换 |
80 |
2017-5-4 8:50:58 |
总公司 |
秋季换 |
80 |
2017-5-4 18:32:42 |
总公司 |
秋季换 |
80 |
2017-5-5 8:54:16 |
总公司 |
秋季换 |
80 |
2017-5-5 18:31:50 |
总公司 |
秋季换 |
80 |
2017-5-6 8:53:42 |
总公司 |
秋季换 |
80 |
2017-5-6 16:35:46 |
总公司 |
秋季换 |
80 |
2017-5-8 8:58:50 |
总公司 |
秋季换 |
80 |
2017-5-8 18:32:10 |
总公司 |
秋季换 |
80 |
2017-5-9 8:56:42 |
总公司 |
秋季换 |
80 |
2017-5-9 18:32:30 |
总公司 |
秋季换 |
80 |
2017-5-10 8:56:43 |
总公司 |
秋季换 |
80 |
2017-5-10 18:32:41 |
总公司 |
秋季换 |
80 |
2017-5-11 8:53:35 |
总公司 |
秋季换 |
80 |
2017-5-11 18:31:22 |
总公司 |
秋季换 |
80 |
2017-5-12 8:55:53 |
总公司 |
秋季换 |
80 |
2017-5-12 18:33:32 |
总公司 |
秋季换 |
80 |
2017-5-13 8:54:28 |
总公司 |
秋季换 |
80 |
2017-5-13 16:34:03 |
总公司 |
秋季换 |
80 |
2017-5-15 8:58:56 |
总公司 |
秋季换 |
80 |
2017-5-15 18:31:22 |
总公司 |
秋季换 |
80 |
2017-5-16 8:57:33 |
总公司 |
秋季换 |
80 |
2017-5-16 18:31:25 |
总公司 |
秋季换 |
80 |
2017-5-17 8:55:57 |
总公司 |
秋季换 |
80 |
2017-5-17 18:33:11 |
总公司 |
秋季换 |
80 |
2017-5-18 8:55:45 |
总公司 |
秋季换 |
80 |
2017-5-18 18:32:48 |
总公司 |
秋季换 |
80 |
2017-5-19 8:55:45 |
总公司 |
秋季换 |
80 |
2017-5-19 18:32:33 |
总公司 |
秋季换 |
80 |
2017-5-22 8:55:17 |
总公司 |
秋季换 |
80 |
2017-5-22 18:30:48 |
总公司 |
秋季换 |
80 |
2017-5-23 8:57:03 |
总公司 |
秋季换 |
80 |
2017-5-23 18:32:03 |
总公司 |
秋季换 |
80 |
2017-5-24 8:58:19 |
总公司 |
秋季换 |
80 |
2017-5-24 18:32:58 |
总公司 |
秋季换 |
80 |
2017-5-25 8:58:50 |
总公司 |
秋季换 |
80 |
2017-5-25 18:34:08 |
总公司 |
秋季换 |
80 |
2017-5-26 8:53:45 |
总公司 |
秋季换 |
80 |
2017-5-26 18:31:15 |
总公司 |
秋季换 |
80 |
2017-5-27 8:54:38 |
总公司 |
秋季换 |
80 |
2017-5-27 17:02:15 |
总公司 |
秋季换 |
80 |
2017-5-31 8:51:33 |
总公司 |
秋季换 |
80 |
2017-5-31 18:31:02 |