stillfish00

¦^´_ 1# softsadwind

1. Private Sub CommandButton1_Click()
   
2.     Application.ScreenUpdating = False
   
3.    
   
4.     'clear
   
5.     Range("G4").Resize(UsedRange.Rows.Count - 3, 4).Clear
   
6.     Sheets("¿z¿ï").Range("G:J").Clear
   
7.    
   
8.     'filter copy
   
9.     Range("A:D").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("G1:I2"), CopyToRange:=Sheets("¿z¿ï").Range("G:J"), Unique:=False
   
10.    
    
11.     'sort, copy back
    
12.     Dim R2 As Long
    
13.     With Sheets("¿z¿ï")
    
14.         R2 = .Range("G65536").End(xlUp).Row
    
15.         .Range("G1:J" & R2).Sort Key1:=.Range("I2:I" & R2), Key2:=.Range("G2:G" & R2), Key3:=.Range("H2:H" & R2), Header:=xlYes
    
16.         .Range("I1:I" & R2).Copy [G4]
    
17.         .Range("G1:H" & R2).Copy [H4]
    
18.         .Range("J1:J" & R2).Copy [J4]
    
19.     End With
    
20.    
    
21.     '®æ¦¡®Ø½u
    
22.     Dim i, j
    
23.     With Range(Range("G4"), Range("G4").End(xlDown))
    
24.         For i = .Columns(1).Rows.Count To 2 Step -1
    
25.             'product
    
26.             If .Cells(i, 1).Value <> .Cells(i - 1, 1) Then
    
27.                 .Cells(i, 1).Resize(, 4).Borders(xlEdgeTop).LineStyle = xlContinuous
    
28.             Else
    
29.                 .Cells(i, 1).Value = ""
    
30.                 .Cells(i, 1).Borders(xlEdgeTop).LineStyle = xlNone
    
31.                
    
32.                 'customer
    
33.                 If .Cells(i, 2).Value <> .Cells(i - 1, 2) Then
    
34.                     .Cells(i, 2).Resize(, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
    
35.                 Else
    
36.                     .Cells(i, 2).Value = ""
    
37.                     .Cells(i, 2).Resize(, 3).Borders(xlEdgeTop).LineStyle = xlNone
    
38.                 End If
    
39.             End If
    
40.             
    
41.         Next i
    
42.     End With
    
43.    
    
44.     Application.ScreenUpdating = True
    
45. End Sub

½Æ»s¥N½X