EXCEL自定义考勤函数

Function kq(tcs, tc, tls, tl, zk)
Rem tcs:stannard of tc,tc:time of come;tl:time of leave
Dim tce, tle 'tce:有效签到时间
Dim tn1s, tn2s
tw = tls - tcs '时间不可为负，否则显示####
tn1s = 0.5  'the time of leaving morning,set12:00，上午下班时间
If tw >= 8 / 24 Then
tn2s = tls - (8 / 24 - (tn1s - tcs))  'the time ofcome afternoon，下午上班时间
Else: tn2s = tn1s
End If
'kq = tn2s
twa = tn1s - tcs  ' the time of AM，上午标准工作时长
twp = tls - tn2s  ' the time of PM，下午标准工作时长
Dim dc As Integer '迟到或早退允许时间
dc = 15

Rem-----------判断签到时间----------------
Dim da1 As Integer
If Not tc Like "--" Then
  On Error GoTo come1
  da1 = DateDiff("n", tcs, tc)'上午签到时差，时间相差的单位为：分钟数
    If da1< -60 Or tc >= tls And Not tc Like "--" Then
    tce = "签到无效": zt_c = "无效" '  Rem 早到1小时以上无效
    ElseIf da1 >= -60 And da1 <= dc Then tce = tcs: zt_c ="正常"
    ElseIf da1 > dc And tc < tls Then tce = tc: zt_c = "迟到"
    Else: tce = "come?"
come1:
    tce = "未签到1": zt_c = "未签"
    End If
End If
If tc Like "--" Then tce = "未签到": zt_c = "未签"
'kq = zt_c
Rem  ----------判断签离时间----------------
Dim dp1 As Integer
  If Not tl Like "--" Then
   On Error GoTo leave1
   dp1 = DateDiff("n", tls,tl)  '下午签离时差，时间相差的单位为：分钟数
    If dp1 >60 Or tl <= tcs Then
     tle = "签离无效": zt_l = "无效"
     ElseIf dp1 <= 60 And dp1 >= -dc Then tle = tls: zt_l ="正常"
     ElseIf dp1 < -dc And tl > tcs And tl <> "--" Then tle =tl: zt_l = "早退"
     Else: tle = "leave?"
leave1:
     tle = "未签离": zt_l = "未签"
    End If
  End If
If tl Like "--" Then tle = "未签离": zt_l = "未签"
'kq = tle
  Rem -----------计算出勤状态－－－－－－－－－－
 Dim xzk
 '---------------------
   If zk Like "外勤" Then
    If tce > 1 And tle > 1 Then
    xzk = "无效"
    Else: xzk = "外勤"
    End If
   End If
  '----------------------------
   If zk = "请假" Then
    If (tce > 1 Or tle > 1) Then
    xzk = "请假"
    Else: xzk = "疑假"
    End If
   End If
 '------------------------------------------
   If (Not zk Like "外勤" And Notzk Like "请假") And zk > 1 Then
    If zt_c = zt_l Then xzk = zt_c
    If zt_c <> zt_l Then xzk = "来：" & zt_c & "；离：" &zt_l
   End If
  ' kq = xzk
  Rem-------------------计算出勤时长----------
    Dim we
    If tce <1 And tle < 1 Then
     If tle <= tn1s Then we = tle - tce
     If tce <= tn1s And tle <= tn2s And tle >= tn1s Then we =tn1s - tce
     If tce <= tn1s And tle >= tn2s Then we = (tn1s - tce) + (tle- tn2s)
     If tce >= tn1s Then we = tle - tn2s
     Else: we = "--"
  End If
    'kq =we
    'If tce <1 Or tle < 1 Then tce = CDate(tce): tle = CDate(tle)
 Dim myarr
myarr = Array(tce, zt_c, tle, zt_l, we, xzk)
kq = myarr
End Function