|
|
Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("加工時間集計")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 5 Then MsgBox "加工時間集計为空！": End
ar = .Range("a4:o" & r)
End With
With Sheets("無作業時間明細")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 5 Then MsgBox "無作業時間明細为空！": End
br = .Range("a4:l" & rs)
End With
With Sheets("工时统计")
ks = .[b1]
js = .[b2]
ReDim arr(1 To UBound(ar) + UBound(br), 1 To 7)
For i = 2 To UBound(ar)
If Trim(ar(i, 7)) <> "" Then
If IsDate(ar(i, 7)) Then
If ar(i, 7) >= ks And ar(i, 7) <= js Then
zd = ar(i, 7) & "|" & ar(i, 8)
t = d(zd)
If t = "" Then
k = k + 1
d(zd) = k
t = k
arr(k, 1) = ar(i, 7)
arr(k, 2) = ar(i, 8)
End If
arr(t, 4) = arr(t, 4) + ar(i, 14)
End If
End If
End If
Next i
For i = 2 To UBound(br)
If Trim(br(i, 1)) <> "" Then
If IsDate(br(i, 1)) Then
If br(i, 1) >= ks And br(i, 1) <= js Then
zd = br(i, 1) & "|" & br(i, 2)
t = d(zd)
If t = "" Then
k = k + 1
d(zd) = k
t = k
arr(k, 1) = br(i, 1)
arr(k, 2) = br(i, 2)
End If
arr(t, 3) = br(i, 3)
arr(t, 5) = arr(t, 5) + ar(i, 9)
End If
End If
End If
Next i
.UsedRange.Offset(4) = Empty
.[a5].Resize(k, UBound(arr, 2)) = arr
For i = 5 To k + 4
.Cells(i, 7).FormulaR1C1 = "=RC[-3]+RC[-2]-RC[-1]"
Next i
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
'
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-8-6 16:02
楼主