[已解决]考勤表

huweifvba

用VBA完成，要求在附件里

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-8 21:20

1. 
   
2. Sub aa()
   
3.     Dim arr1, arr2
   
4.     Dim i As Long
   
5.     Dim t, h
   
6.     arr1 = Range("A2:A" & [A65536].End(xlUp).Row)
   
7.     ReDim arr2(1 To UBound(arr1), 1 To 1)
   
8.     For i = 1 To UBound(arr1)
   
9.         t = VBA.Weekday(arr1(i, 1), 2)
   
10.         h = VBA.Hour(arr1(i, 1)) + VBA.Minute(arr1(i, 1)) / 60
    
11.         If t > 5 Then
    
12.             arr2(i, 1) = "双休日"
    
13.         ElseIf h > 8.5 And h < 12 Then
    
14.             arr2(i, 1) = "迟到"
    
15.         ElseIf h > 13 And h < 17.5 Then
    
16.             arr2(i, 1) = "早退"
    
17.         End If
    
18.     Next i
    
19.     Range("B2").Resize(UBound(arr2), 1) = arr2
    
20. End Sub

复制代码

附件： 考勤-sunjing.rar (9.51 KB, 下载次数: 39)

2012-1-8 21:22 上传

点击文件名下载附件

跳转到最佳答案楼层

sunjing-zxl

1. 
   
2. Sub aa()
   
3.     Dim arr1, arr2
   
4.     Dim i As Long
   
5.     Dim t, h
   
6.     arr1 = Range("A2:A" & [A65536].End(xlUp).Row)
   
7.     ReDim arr2(1 To UBound(arr1), 1 To 1)
   
8.     For i = 1 To UBound(arr1)
   
9.         t = VBA.Weekday(arr1(i, 1), 2)
   
10.         h = VBA.Hour(arr1(i, 1)) + VBA.Minute(arr1(i, 1)) / 60
    
11.         If t > 5 Then
    
12.             arr2(i, 1) = "双休日"
    
13.         ElseIf h > 8.5 And h < 12 Then
    
14.             arr2(i, 1) = "迟到"
    
15.         ElseIf h > 13 And h < 17.5 Then
    
16.             arr2(i, 1) = "早退"
    
17.         End If
    
18.     Next i
    
19.     Range("B2").Resize(UBound(arr2), 1) = arr2
    
20. End Sub

复制代码

附件： 考勤-sunjing.rar (9.51 KB, 下载次数: 39)

2012-1-8 21:22 上传

点击文件名下载附件

szczm121

很多高手，希望在这里能学到很多VBA知识