计算时间

风雨相随3

计算时间.zip (6.98 KB, 下载次数: 9)

2018-9-8 14:55 上传

点击文件名下载附件

请高手用来宏完成，               
表出勤时间有人员3800人，               
要求出每人每周累计上班时间        ，        
表汇算是用公式模似的结果。               

不知道为什么

是按一年的第几周统计的。如图

不知道为什么

参考

风雨相随3

能传附件上来不?

风雨相随3

不知道为什么 发表于 2018-9-8 15:29
参考

能传附件上来不?excel2003运行不了weeknum.

lsc900707

风雨相随3 发表于 2018-9-8 18:52
能传附件上来不?excel2003运行不了weeknum.

应该不是这个原因吧？

风雨相随3

lsc900707 发表于 2018-9-8 19:05
应该不是这个原因吧？

X:\Users\hnvfhppv\Desktop

风雨相随3

lsc900707 发表于 2018-9-8 19:05
应该不是这个原因吧？

Sub 出勤()
Dim Arr, Brr, i%, WT%, wD$, x%, y&
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Arr = Sheets("出勤时间").[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 100)

For i = 2 To UBound(Arr)
WT = Arr(i, 6) + Arr(i, 7) + Arr(i, 8) + Arr(i, 9)
wD = "第" & WorksheetFunction.WeekMum(Arr(i, 1)) & "周"
If Not Dic.exists(wD) Then
y = y + 1
Dic(wD) = y
Brr(1, y) = wD
End If
If Not Dic.exists(Arr(i, 2)) Then
x = x + 1

Dic(Arr(i, 2)) = x
Brr(x, 1) = Arr(i, 2): Brr(x, 2) = Arr(i, 3)
Brr(x, Dic(wD)) = WT


Else
Brr(Dic(Arr(i, 2)), Dic(wD)) = Brr(Dic(Arr(i, 2)), Dic(wD)) + wD
End If
Next i
Brr(1, 2) = "姓名"
Brr(1, 1) = "工号"
With Sheets("汇算")
Cells.ClearContents
.[a1].Resize(x, y) = Brr
End With
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
望援手，找出原因。

lsc900707

风雨相随3 发表于 2018-9-8 19:12
Sub 出勤()
Dim Arr, Brr, i%, WT%, wD$, x%, y&
Set Dic = CreateObject("Scripting.Dictionary")

wD = "第" & WorksheetFunction.WeekMum(Arr(i, 1)) & "周"
应该是：wD = "第" & WorksheetFunction.WeekNum(Arr(i, 1)) & "周"

风雨相随3

lsc900707 发表于 2018-9-8 20:08
wD = "第" & WorksheetFunction.WeekMum(Arr(i, 1)) & "周"
应该是：wD = "第" & WorksheetFunction.Wee ...

Sub 出勤()
Dim Arr, Brr, i%, WT%, wD$, x%, y&
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Arr = Sheets("出勤时间").[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 100)

For i = 2 To UBound(Arr)
WT = Arr(i, 6) + Arr(i, 7) + Arr(i, 8) + Arr(i, 9)
wD = "第" & WorksheetFunction.WeekNum(Arr(i, 1)) & "周"
If Not Dic.exists(wD) Then
y = y + 1
Dic(wD) = y
Brr(1, y) = wD
End If
If Not Dic.exists(Arr(i, 2)) Then
x = x + 1

Dic(Arr(i, 2)) = x
Brr(x, 1) = Arr(i, 2): Brr(x, 2) = Arr(i, 3)
Brr(x, Dic(wD)) = WT


Else
Brr(Dic(Arr(i, 2)), Dic(wD)) = Brr(Dic(Arr(i, 2)), Dic(wD)) + wD
End If
Next i
Brr(1, 2) = "姓名"
Brr(1, 1) = "工号"
With Sheets("汇算")
Cells.ClearContents
.[a1].Resize(x, y) = Brr
End With
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub现在是这句过不了。