GBKEE

¦^´_ 2# eric093
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, d As Object, i As Variant, A As String
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set Rng =¤u§@ªí1.Range("a1").CurrentRegion
   
6.     For i = 2 To Rng.Rows.Count
   
7.         A = Rng(i, 1) & "-" & Rng(i, 2)
   
8.         If d.EXISTS(A) Then   '¦r¨åª«¥óªº(key­È)¦s¦b¶Ç¦^True
   
9.             Set d(A) = Union(Rng.Rows(i), d(A))
   
10.         Else
    
11.             Set d(A) = Rng.Rows(i)
    
12.         End If
    
13.     Next
    
14.     For Each i In d.KEYS
    
15.         If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "¨ú®ø") = 0 Then
    
16.             d(i).Delete xlUp
    
17.         ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
    
18.             d(i).Delete xlUp
    
19. 
    
20.         End If
    
21.     Next
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 4# eric093
xlsx ¬O¨S¦³¥¨¶°ªºExcelÀÉ, xlsm ¤~¥i¦s©ñµ{¦¡½X.

1. Option Explicit
   
2. Sub ¥¼¤J´Ú2()
   
3.     Application.ScreenUpdating = False
   
4.     Dim j As Integer
   
5.     Dim E As Range
   
6.     '******«Å§iÅܼƪº«¬ºA ,»Ý¨Ì¨Ìªº«ü©w«¬ºA  **********
   
7.     Dim xragne As Range, yrange As Range, wrange As Range
   
8.     '*******************
   
9.     Set E = Sheets("¥¼¤J´Ú").Range("e2")
   
10.     Application.DisplayAlerts = False
    
11.     Do While E <> ""                 'orderid ªº°j°é
    
12.         If E.Offset(, 34) = "¥I´Ú½T»{" Then              '¥I´Ú½T»{­n§R°£
    
13.             If wrange Is Nothing Then
    
14.                 Set wrange = E
    
15.             Else
    
16.                 Set wrange = Union(wrange, E)
    
17.             End If
    
18.         End If
    
19.         j = 1
    
20.         Do While E.Offset(j) <> ""                     '¨C¤@­Óorderid©¹¤Uªº°j°é
    
21.             If E.Offset(j) = E Then                     ' ¬Û¦Pªº orderid
    
22.                 If E.Offset(, 1) = E.Offset(j, 1) Then  ' ¬Û¦Pªº itemid ­n§R°£
    
23.                     If wrange Is Nothing Then
    
24.                         Set wrange = Union(E, E.Offset(j))
    
25.                     Else
    
26.                         Set wrange = Union(wrange, E, E.Offset(j))
    
27.                     End If
    
28.                 End If
    
29.             End If
    
30.             j = j + 1
    
31.         Loop
    
32.         Set E = E.Offset(1)
    
33.     Loop
    
34.     If Not wrange Is Nothing Then wrange.EntireRow.Delete
    
35. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# eric093

1. Dictionary ª«¥ó
   
2. ¥i¥H¬O¥ô¦ó«¬¦¡ªº¸ê®Æªº¶µ¥Ø³QÀx¦s¦b°}¦C¤¤¡C¨C­Ó¶µ¥Ø³£»P¤@­Ó°ß¤@ªºÃöÁä¦r¬ÛÃö¡C¸ÓÃöÁä¦r¥Î¨Ó¨ú¥X³æ­Ó¶µ¥Ø¡A³q±`¬O¾ã¼Æ©Î¦r¦ê¡A¥i¥H¬O°£°}¦C¥~ªº¥ô¦ó«¬ºA¡C

½Æ»s¥N½X

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, d As Object, i As Variant, A As String
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set Rng = ¤u§@ªí1.Range("a1").CurrentRegion
   
6.     For i = 2 To Rng.Rows.Count
   
7.         A = Rng(i, 1) & "-" & Rng(i, 2)
   
8.         If d.EXISTS(A) Then   '¦r¨åª«¥óªº(key­È)¦s¦b¶Ç¦^True
   
9.             Set d(A) = Union(Rng.Rows(i), d(A)) ' ==========¡H¡H
   
10.         Else
    
11.             Set d(A) = Rng.Rows(i)   '==========¡H¡H
    
12.         End If
    
13.         MsgBox d(A).Address
    
14.     Next
    
15.     For Each i In d.KEYS  '==========¡H¡H
    
16.         MsgBox i
    
17.         If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "¨ú®ø") = 0 Then
    
18.             d(i).Delete xlUp
    
19.         ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
    
20.             d(i).Delete xlUp
    
21.         End If
    
22.     Next
    
23. End Sub

½Æ»s¥N½X