Hsieh

¦^´_ 1# b9208

1. Sub ex()
   
2. Dim A As Range, Rng As Range
   
3. With Sheets("¸ê®Æ")
   
4.    For Each A In .Range(.[F6], .[F6].End(xlDown))
   
5.       If Application.CountIf(Sheets("³æ¦ì").Rows(3), A) > 0 Then
   
6.          If Rng Is Nothing Then Set Rng = A Else Set Rng = Union(Rng, A)
   
7.       End If
   
8.    Next
   
9. End With
   
10. With Sheets("³æ¦ì")
    
11. .[A19].CurrentRegion.Offset(1) = ""
    
12. If Not Rng Is Nothing Then Rng.EntireRow.Copy .[A20]
    
13. .[A19].CurrentRegion.Sort key1:=.[F20], key2:=.[E20], key3:=.[H20], Header:=xlYes
    
14. End With
    
15. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 10# b9208

Rng.AdvancedFilter xlFilterCopy, .Range(.[c3], .[c3].End(xlDown)), CopyTo, False

Hsieh

¦^´_ 12# b9208
¼ÐÃD¦C¸T¥Î¦X¨ÖÀx¦s®æ¡A³o¬O¸ê®Æ®w¨Ï¥Î¥²¶·¿í¦uªº­ì«h
§A³o¼Ë·|³y¦¨µLªk¨Ï¥Î¶i¶¥¿z¿ï

Hsieh

¦^´_ 16# b9208

1. Sub ex()
   
2. Dim A As Range, C As Range, Rng As Range, MyRng As Range, m$
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. With Sheets("³æ¦ì")
   
6. Set Rng = .[D3:G3]
   
7.    With Sheets("¸ê®Æ")
   
8.       For Each A In .Range(.[F6], .[F6].End(xlDown))
   
9.       m = A.Offset(, -3) & A & A.Offset(, 2)
   
10.       If d(m) <= A.Offset(, 5).Value Then d(m) = A.Offset(, 5).Value '°O¦í³Ì¤j­È
    
11.       d1(m) = d1(m) + 1 '­pºâ­Ó¼Æ
    
12.          Set C = Rng.Find(A, lookat:=xlWhole)
    
13.          If Not C Is Nothing Then
    
14.            If MyRng Is Nothing Then Set MyRng = A.Offset(, -5).Resize(, 13) Else Set MyRng = Union(MyRng, A.Offset(, -5).Resize(, 13))
    
15.          End If
    
16.       Next
    
17.     End With
    
18.     .Range("A19").CurrentRegion.Interior.ColorIndex = 0
    
19.     If Not MyRng Is Nothing Then MyRng.Copy .[A20] Else MsgBox "µL²Å¦X¸ê®Æ": Exit Sub
    
20.     .Range("A19").CurrentRegion.Sort key1:=.[K19], Header:=xlYes
    
21.     .Range("A19").CurrentRegion.Sort key1:=.[F19], key2:=.[C19], key3:=.[H19], Header:=xlYes
    
22.     For Each A In .Range(.[F20], .[F20].End(xlDown))
    
23.     m = A.Offset(, -3) & A & A.Offset(, 2)
    
24.        If d1(m) > 1 Then A.Offset(, -5).Resize(, 13).Interior.ColorIndex = 6 '¦³­«½Æ
    
25.        If A.Offset(, 5) <> d(m) Then A.Offset(, 5) = 0 '¤£µ¥©ó³Ì¤j­È´NÂk¹s
    
26.     Next
    
27. End With
    
28. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 18# b9208

³Ì«á¤@¥y
       If A.Offset(, 5) <> d(m) Then A.Offset(, 5) = 0 Else d(m) = 0 '¤£µ¥©ó³Ì¤j­È´NÂk¹s