chin15

1. Sub test()
   
2.     Dim c%, r%, arr(1 To 6, 1 To 3), d As Range, a#, b#
   
3.     [i4:k9] = ""
   
4.     For c = 1 To 3
   
5.         For r = 1 To 6
   
6.             For Each d In [e4:e11]
   
7.                 a = Cells(3, c + 8) + Left(Cells(r + 3, 8), 2) / 24
   
8.                 b = a + 0.166667
   
9.                 If d >= a And d < b Then
   
10.                     arr(r, c) = arr(r, c) + d(1, 2)
    
11.                 End If
    
12.             Next
    
13.         Next
    
14.     Next
    
15.     [i4].Resize(6, 3) = arr
    
16. End Sub

½Æ»s¥N½X