|
|
Sub 统计餐补()
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("消费明细")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "消费明细为空！": End
ar = .Range("a1:f" & r)
End With
Dim br()
ReDim br(1 To UBound(ar), 1 To 10)
For i = 2 To UBound(ar)
If ar(i, 4) <> "" Then
If IsDate(ar(i, 5)) Then
rq = CDate(Format(ar(i, 5), "yyyy/mm/dd"))
zd = ar(i, 3) & "|" & ar(i, 4) & "|" & rq
If Not d.exists(zd) Then Set d(zd) = CreateObject("scripting.dictionary")
d(zd)(i) = ""
End If
End If
Next i
For Each k In d.keys
rr = Split(k, "|")
zd = rr(0) & "|" & rr(2)
t = dc(zd)
If t = "" Then
n = n + 1
dc(zd) = n
t = n
br(n, 1) = rr(0)
br(n, 2) = rr(1)
br(n, 3) = rr(2)
End If
For Each kk In d(k).keys
sj = Format(ar(kk, 5), "h:mm:ss")
If TimeValue(sj) >= TimeValue("17:00:00") Then
br(t, 4) = br(t, 4) + Val(ar(kk, 6))
If br(t, 4) > 10 Then
br(t, 8) = 10
Else
br(t, 8) = Val(ar(kk, 6))
End If
ElseIf TimeValue(sj) >= TimeValue("11:00:00") And TimeValue(sj) <= TimeValue("13:00:00") Then
br(t, 5) = br(t, 5) + Val(ar(kk, 6))
If br(t, 5) > 14 Then
br(t, 9) = 14
Else
br(t, 9) = Val(ar(kk, 6))
End If
ElseIf TimeValue(sj) >= TimeValue("6:30:00") And TimeValue(sj) <= TimeValue("9:30:00") Then
br(t, 6) = br(t, 6) + Val(ar(kk, 6))
If br(t, 6) > 5 Then
br(t, 10) = 5
Else
br(t, 10) = Val(ar(kk, 6))
End If
End If
Next kk
Next k
With Sheets("效果")
.[a1].CurrentRegion.Offset(2).Borders.LineStyle = 0
.[a1].CurrentRegion.Offset(2) = Empty
.[a3].Resize(n, UBound(br, 2)) = br
.[a3].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub
|
|
楼主: 烟火孤星泪
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-9-8 12:05
楼主
