|
- Sub 统计()
- Dim oDic As Object
- Dim vData As Variant, iData As Integer
- Dim vFill As Variant, iFill As Integer
- Dim iYear As Integer, iMonth As Integer
- Dim iStartDay As Integer
- Dim iTotalDay As Integer
- Dim dStart As Date, dEnd As Date, sTime As String, iDay As Integer
- Dim iRow As Integer, iTime As Integer 'iTime时间段,0早,1中,2晚,3上班时间
- Set oDic = CreateObject("Scripting.Dictionary")
- With Worksheets("Sheet1")
- vData = Split(.[A3].Text, "年") '要求F1必须以“2016年3月”的格式填
- If UBound(vData) <> 1 Then
- MsgBox "年月没有正确填写,请按“2016年3月”的格式填!", , "Write By:Micro"
- [A3].Select
- Exit Sub
- End If
- iYear = Val(vData(0)) '年份
- vData = Split(vData(1), "月")
- iMonth = Val(vData(0)) '月份
- iStartDay = Val(.[B3].Value) '开始日期
- iTotalDay = Int((.[A3].CurrentRegion.Columns.Count - 2) / 4) + 1 '表格内已填多少个日期
- End With
- With Worksheets("5")
- iData = .[B65536].End(xlUp).Row - 2
- If iYear < 2000 And iMonth < 1 And iStartDay < 1 And iTotalDay < 1 And iData < 1 Then Exit Sub
- dStart = DateSerial(iYear, iMonth, iStartDay)
- dEnd = DateSerial(iYear, iMonth, iStartDay + iTotalDay)
- ReDim vFill(1 To iTotalDay * 4 + 1, 1 To 1)
- vData = .[B3].Resize(iData, 2).Value
- End With
- With Worksheets("Sheet1")
- For iData = 1 To UBound(vData)
- If vData(iData, 2) >= dStart And vData(iData, 2) <= dEnd Then
- If Not oDic.Exists(vData(iData, 1)) Then
- iFill = iFill + 1
- ReDim Preserve vFill(1 To iTotalDay * 4 + 1, 1 To iFill)
- oDic(vData(iData, 1)) = iFill
- vFill(1, iFill) = vData(iData, 1)
- For iRow = 2 To iTotalDay * 4 + 1
- vFill(iRow, iFill) = "缺签"
- Next
- End If
- iRow = oDic(vData(iData, 1))
- sTime = Format(vData(iData, 2), "HH:MM")
- iDay = Day(vData(iData, 2))
- If sTime <= "09:00" Then
- If sTime <= IIf(IsDate(vFill(2 + (iDay - iStartDay) * 4, iRow)), Format(vFill(2 + (iDay - iStartDay) * 4, iRow), "HH:MM"), "08:30") Then _
- vFill(2 + (iDay - iStartDay) * 4, iRow) = TimeValue(sTime)
- ElseIf sTime >= "12:00" And sTime <= "15:00" Then
- If sTime >= IIf(IsDate(vFill(3 + (iDay - iStartDay) * 4, iRow)), Format(vFill(3 + (iDay - iStartDay) * 4, iRow), "HH:MM"), "12:00") Then _
- vFill(3 + (iDay - iStartDay) * 4, iRow) = TimeValue(sTime)
- ElseIf sTime >= "15:30" And sTime <= "17:30" Then
- If sTime >= IIf(IsDate(vFill(4 + (iDay - iStartDay) * 4, iRow)), Format(vFill(4 + (iDay - iStartDay) * 4, iRow), "HH:MM"), "15:00") Then _
- vFill(4 + (iDay - iStartDay) * 4, iRow) = TimeValue(sTime)
- ElseIf sTime >= "17:30" Then
- If sTime >= IIf(IsDate(vFill(5 + (iDay - iStartDay) * 4, iRow)), Format(vFill(5 + (iDay - iStartDay) * 4, iRow), "HH:MM"), "17:30") Then _
- vFill(5 + (iDay - iStartDay) * 4, iRow) = TimeValue(sTime)
- End If
- End If
- Next
- iRow = .[A65536].End(xlUp).Row
- If iRow > 4 Then .[A5].Resize(iRow - 2, iTotalDay * 4 + 1).ClearContents
- If iFill > 0 Then .[A5].Resize(iFill, iTotalDay * 4 + 1) = Application.WorksheetFunction.Transpose(vFill)
- End With
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|