GBKEE

¦^´_ 1# sujane0701
¸Õ¸Õ¬Ý ¥u¥i°Ï¤ÀÀx¦s®æ¦â±m ¦³©ÎµL

1. Sub Ex()
   
2.     Dim i%, Rng As Range, R, D(1 To 2) As Object, C%
   
3.     For i = 7 To 6 + (3 * 8) Step 3
   
4.         If Cells(Rows.Count, i).End(xlUp) <> Cells(1, i) Then
   
5.             Set D(1) = CreateObject("Scripting.Dictionary")
   
6.             Set D(2) = CreateObject("Scripting.Dictionary")
   
7.             Set Rng = Range(Cells(1, i), Cells(1, i).End(xlDown)).Resize(, 3)
   
8.             For Each R In Rng.Columns(1).Cells
   
9.                 If R.Interior.ColorIndex <> xlNone Then  ' <>xlNone-> ¤£µ¥©óµL¦â±m
   
10.                     D(1)(R.Value) = R.Resize(, 3)
    
11.                     C = R.Interior.ColorIndex             '¨ú±o¦â±mªº No
    
12.                 Else  '  µL¦â±m
    
13.                     D(2)(R.Value) = R.Resize(, 3)
    
14.                 End If
    
15.             Next
    
16.             If D(1).Count > 0 Then
    
17.                 With Rng(1).Resize(D(1).Count, 3)
    
18.                     .Value = Application.Transpose(Application.Transpose(D(1).ITEMS))
    
19.                     .Interior.ColorIndex = C
    
20.                     .Sort Key1:=Rng(1), Header:=xlNo    'xlNoµL¼ÐÃD
    
21.                 End With
    
22.             End If
    
23.             If D(2).Count > 0 Then
    
24.                 With Rng(D(1).Count + 1, 1).Resize(D(2).Count, 3)
    
25.                     .Value = Application.Transpose(Application.Transpose(D(2).ITEMS))
    
26.                     .Interior.ColorIndex = xlNone
    
27.                     .Sort Key1:=Rng(D(1).Count + 1, 1), Header:=xlNo
    
28.                 End With
    
29.             End If
    
30.         End If
    
31.     Next
    
32. End Sub

½Æ»s¥N½X