GBKEE

¦^´_ 6# rouber590324

¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 2) As Range
   
4.      Set Rng(1) = ActiveSheet.Range("a1").CurrentRegion  '¸ê®Æ©Ò¦bªº½d³ò
   
5.      Set Rng(2) = ActiveSheet.Cells(1, Columns.Count - Rng(1).Columns.Count)
   
6.      With Rng(1)
   
7.         .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Range("B1:D1"), Unique:=True
   
8.         'Rng(1)ªº¶i¶¥¿z¿ï:,  ½d³ò¤¤ªº B:D Äæ,¤£­«½Æªº¸ê®Æ
   
9.         .Copy Rng(2)
   
10.         .AdvancedFilter xlFilterInPlace    '¥þ³¡¸ê®ÆÅã¥Ü
    
11.         .Cells.Clear
    
12.        End With
    
13.        Rng(2).CurrentRegion.Copy Rng(1)(1)
    
14.        Rng(2).Clear
    
15. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# greetingsfromtw
VBA ¦³³\¦h¼gªk¥i¹F¨ì¬Û¦Pªº®ÄªG

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, AR(), i As Integer
   
4.     Set D = CreateObject("scripting.dictionary")
   
5.     AR = Range("a1:d" & Cells(Rows.Count, 1).End(xlUp).Row)
   
6.     For i = 1 To UBound(AR)
   
7.       If Not D.exists(AR(i, 2) & AR(i, 3) & AR(i, 4)) Then  '** exists  ¶Ç¦^¦r¨åª«¥ó¬O§_¦³³okey­È  ¦³ True :µL False
   
8.         D(AR(i, 2) & AR(i, 3) & AR(i, 4)) = Application.Index(AR, i)  '** ¤u§@ªí¨ç¼Æ Index
   
9.       End If
   
10.     Next
    
11.     With Range("H1")
    
12.         .CurrentRegion.Clear
    
13.         .Resize(D.Count, 4) = Application.Transpose(Application.Transpose(D.items))
    
14.     End With
    
15. End Sub
    
16. Sub Ex1()
    
17.     Dim D As Object, i As Integer
    
18.     Set D = CreateObject("scripting.dictionary")
    
19.     With Range("a1:d" & Cells(Rows.Count, 1).End(xlUp).Row)
    
20.         For i = 1 To .Rows.Count
    
21.             If Not D.exists(.Cells(i, 2) & Cells(i, 3) & .Cells(i, 4)) Then '** exists  ¶Ç¦^¦r¨åª«¥ó¬O§_¦³³okey­È  ¦³ True :µL False
    
22.                 D(.Cells(i, 2) & Cells(i, 3) & .Cells(i, 4)) = .Rows(i)
    
23.             End If
    
24.         Next
    
25.     End With
    
26.     With Range("H1")
    
27.         .CurrentRegion.Clear
    
28.          .Resize(D.Count, 4) = Application.Transpose(Application.Transpose(D.items))
    
29.     End With
    
30. End Sub
    
31. Sub Ex2()
    
32.     Dim AR, ArSt(), i As Integer, St As String
    
33.     With Range("a1:d" & Cells(Rows.Count, 1).End(xlUp).Row)
    
34.         For i = 1 To .Rows.Count
    
35.                 St = .Cells(i, 2) & Cells(i, 3) & .Cells(i, 4)
    
36.                 If IsEmpty(AR) Then
    
37.                     ReDim AR(1 To 1):     AR(1) = .Rows(i)
    
38.                     ReDim ArSt(1 To 1):   ArSt(1) = St
    
39.                 Else
    
40.                     If UBound(Filter(ArSt, St)) = -1 Then
    
41.                         'Filter ¨ç¼Æ¶Ç¦^¤@­Ó±q¹s¶}©lªº°}¦C¡A¸Ó°}¦C¥]§t°ò©ó«ü©w¿z¿ï·Ç«hªº¤@­Ó¦r¦ê°}¦Cªº¤l¶°¡C
    
42.                         '»yªk  Filter(sourcesrray, match[, include[, compare]])
    
43.                         '¦pªG¦b sourcearray ¤¤¨S¦³µo²{»P match ¬Û²Å¦Xªº­È¡AFilter ¶Ç¦^¤@­ÓµL°}¦C¡C¦pªG sourcearray ¬O Null ©Î¤£¬O¤@­Ó¤@ºû°}¦C¡A«h²£¥Í¿ù»~¡C
    
44.                         'Filter ¨ç¼Æ©Ò¶Ç¦^ªº°}¦C¡A¨ä²Õ¦¨¶µ¥Ø¼Æ­è¦n¬O©Ò§ä¨ìªº²Å¦X¶µ¥Ø¼Æ¡C
    
45.                         ReDim Preserve ArSt(1 To UBound(ArSt) + 1)
    
46.                         ArSt(UBound(ArSt)) = St
    
47.                         ReDim Preserve AR(1 To UBound(AR) + 1)
    
48.                         AR(UBound(AR)) = .Rows(i)
    
49.                     End If
    
50.             End If
    
51.         Next
    
52.     End With
    
53.     With Range("H1")
    
54.         .CurrentRegion.Clear
    
55.          .Resize(UBound(AR), 4) = Application.Transpose(Application.Transpose(AR))
    
56.     End With
    
57. End Sub

½Æ»s¥N½X