Hsieh

¦^´_ 1# an13755


    §A¥Ø«eBªíªº¼Æ¾Ú¬O§¹¾ãªº¶Ü?
¨Ì§Úªº²z¸Ñ§A¥ý¬Ý¬Ý

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. With Sheet36
   
5.   For k = 2 To 9
   
6.      For r = 2 To .Cells(65536, k).End(xlUp).Row
   
7.         d(.Cells(r, k).Value) = d(.Cells(r, k).Value) + .Cells(r, 10)
   
8.         If d(.Cells(r, k).Value) < 20 Then d1(.Cells(r, k).Value) = .Cells(r, "K")
   
9.      Next
   
10.      ar = d.keys
    
11.      ReDim ay(d1.Count)
    
12.      For i = 1 To d1.Count
    
13.        n = Application.Small(ar, i)
    
14.        ay(i - 1) = d1(n)
    
15.      Next
    
16. With Sheet1
    
17. .Columns(k + 8) = ""
    
18. .Cells(1, k + 8).Resize(d1.Count, 1) = Application.Transpose(ay)
    
19. End With
    
20.   d.RemoveAll
    
21.   d1.RemoveAll
    
22.   Next
    
23. End With
    
24. End Sub

½Æ»s¥N½X

°õ¦æ«áµª®×¦bJ:QÄæ§A¤ñ¸û¬Ý¬Ý®t²§¦b­þ?

Hsieh

¦^´_ 4# an13755


    06¦æ·|¥X¿ù?¤£·|§a
­ì¨Ó¬O­n³o¼Ëªºµ²ªG,§Ú·|¿ù·N¤F

1. Sub nn()
   
2. Dim Ar()
   
3. Application.ScreenUpdating = False
   
4. With Sheet36
   
5.   For k = 2 To 9
   
6.    s = 0: r = 2
   
7.   .Cells(1, k).CurrentRegion.Sort key1:=.Cells(1, k), Header:=xlYes
   
8.   cnt = .Cells(r, "J")
   
9. While cnt < 20
   
10.   ReDim Preserve Ar(s)
    
11.   Ar(s) = .Cells(r, "K")
    
12.   s = s + 1: r = r + 1
    
13.   cnt = cnt + .Cells(r, "J")
    
14. Wend
    
15. With Sheet1
    
16. .Columns(k + 8) = ""
    
17. .Cells(1, k + 8).Resize(s, 1) = Application.Transpose(Ar)
    
18. End With
    
19. Erase Ar
    
20.   Next
    
21. .[A1].CurrentRegion.Sort key1:=.[A1], Header:=xlYes
    
22. End With
    
23. Application.ScreenUpdating = True
    
24. End Sub

½Æ»s¥N½X