­ã´£³¡ªL

1. Sub test_1()
   
2. Dim xD As Object, Arr, Brr, V, N&, U%, i&, j%, k%, Km%
   
3. Set xD = CreateObject("Scripting.Dictionary")
   
4. s = Array(1, 5, 10, 15, 20, 30, 40, 50, 100, 200, 400, 600, 800, 1000, 2000, 3000, 60000)
   
5. Arr = Range("A8:C" & [A65536].End(3).Row)
   
6. 
   
7. ReDim Brr(1 To UBound(Arr), 1 To UBound(s) * 4 + 1)
   
8. del
   
9. For i = 1 To UBound(Arr)
   
10.     V = Arr(i, 1): U = xD(V)
    
11.     If U = 0 Then N = N + 1: U = N: xD(V) = N: Brr(U, 1) = V
    
12.     For j = 2 To 3
    
13.         Km = 0
    
14.         For k = 0 To UBound(s)
    
15.             If s(k) * 1000 > Arr(i, j) Then Km = (k - 1) * 4: Exit For
    
16.         Next k
    
17.         If Km >= 0 Then
    
18.            Brr(U, Km + j * 2 - 2) = Brr(U, Km + j * 2 - 2) + Arr(i, j)
    
19.            Brr(U, Km + j * 2 - 1) = Brr(U, Km + j * 2 - 1) + 1
    
20.         End If
    
21.     Next j
    
22. Next i
    
23. With [D8].Resize(N, UBound(s) * 4 + 1)
    
24.      .Value = Brr
    
25.      .Sort Key1:=.Item(1), Order1:=xlDescending, Header:=xlNo
    
26. End With
    
27. End Sub

½Æ»s¥N½X