­ã´£³¡ªL

Sub TEST()
Dim i&, R&, C&, xD, xArea As Range, Arr, xR As Range, X&, Y&, Z%
C = [IV2].End(xlToLeft).Column
R = [B65536].End(xlUp).Row
Set xD = CreateObject("Scripting.Dictionary")
For i = 4 To R Step 4:  xD(Cells(i, 1) & "") = i - 3: Next i¡@¡@'¨ú±o¡eTester No¡fªº¡e¦C¦ì¡f
For i = 3 To C:  xD(Format(Cells(2, i), "yyyy-mm-dd")) = i - 2: Next i¡@'¨ú±o¤é´Áªº¡eÄæ¦ì¡f
Set xArea = [C4].Resize(R - 3, C - 2)¡@'²Î­p¼Æ­È°Ï
xArea.ClearContents: Arr = xArea¡@'²M°£²Î­p¡A¥HArr¥N¥X
¡@
For Each xR In Range([summary!D3], [summary!D65536].End(xlUp))
¡@¡@X = xD(xR.Value)¡@'¡eTester No¡fªº¡e¦C¦ì¡f
¡@¡@Y = xD(Format(xR(1, 3), "yyyy-mm-dd"))¡@'¤é´Áªº¡eÄæ¦ì¡f
¡@¡@If X = 0 Or Y = 0 Then GoTo 101
¡@¡@Z = Int(Hour(xR(1, 3)) / 8)¡@'¦­¤È±ß®É¬q­pºâ
¡@¡@Arr(X + Z, Y) = Arr(X + Z, Y) + 1¡@'²Ö­p®É¬q¦¸¼Æ
¡@¡@Arr(X + 3, Y) = Arr(X + 3, Y) + 1¡@'²Ö­p·í¤é¦¸¼Æ
101: Next
xArea = Arr
End Sub