½Ð°ª¤âÀ°¦£Åo

eric093

¤p§Ì­n­pºâ­q³æ´¿¸g¤J´Úªºµ§¼Æ¡A
¦ý¬O¤½¥q¨t²Î·|¦]¬°Åܧó¥I´Ú¤è¦¡«á¦Ó²£¥Í¤G­Ó¶µ¦¸¡A
©Ò¥H¡A¥d¦í¤F¡A¤£ª¾¹D¸Ó¥Î¤°»ò¤èªk¸Ñ¨M¡I
½ÐÀ°¦£¡I

eric093

¦^´_ 1# eric093

¥Hªþ¥ó¤º®e°õ¦æ«áµ²ªGÀ³¸Ó¦p¤U¡A¤]´N¬O»¡¡A³o­q³æ¸¹½X´¿¸g¥I´Ú¹L¡A¤J´Ú¹L¡A§Ú´N­n§R°£¡A¥u¯d¤U¤£´¿¤J´Ú¹Lªº

­q³æ¸¹½X        ¶µ¦¸        ¥I´Úª¬ªp
12345        1        ¨ú®ø

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

eric093

¦^´_ 2# eric093


    ·PÁ¤j¤j¡A¤£¹L¡A³o¹ï§Ú¨Ó»¡¤ÓÃø¤F¡A§Ú±oºCºC¬ã¨s¡I
¥t¥~¡A§Ú¥Î§Ú·|ªº¤è¦¡¼g¡A¦ý¦³°ÝÃD¡A¤j¤j¥i¥HÀ°§Ú¬Ý¤@¤U¶Ü¡H

Sub ¥¼¤J´Ú2()

Application.ScreenUpdating = False
Dim j As Integer
Dim E As Range
Dim xragne, yrange, wrange As Range
Set E = Sheets("¥¼¤J´Ú").Range("e2")

Application.DisplayAlerts = False


Do While E <> ""
j = 1
     If E.Offset(j) = E Then
     
        
        If E.Offset(, 1) = E.Offset(j, 1) Then
          If E.Offset(, 34) <> E.Offset(j, 34) Then
               If yrange Is Nothing Then Set yrange = E
               If wrange Is Nothing Then Set wrange = E.Offset(1)
              Set yrange = Union(yrange, E)
              Set wrange = Union(wrange, E.Offset(1))
           End If
         
        End If
    Else
     If E(1).Offset(, 34) = "¥I´Ú½T»{" Then
       If xragne Is Nothing Then Set xragne = E
              Set xragne = Union(xragne, E)

          End If
    End If
    Set E = E.Offset(1)
    j = j + 1
Loop
If Not xragne Is Nothing Then xragne.EntireRow.Delete
If Not yrange Is Nothing Then yrange.EntireRow.Delete
If Not wrange Is Nothing Then wrange.EntireRow.Delete
End Sub

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

eric093

¦^´_ 5# GBKEE


    ÁÂÁª©¤j¡A§Ú¨Ó¬Ý¤@¤U§Ú¼g­þ¥X¿ù¤F

eric093

¦^´_ 3# GBKEE

ª©¥D¡G°ÝÃD¬O¸Ñ¨M¤F¡A¦ý§Ú§ä¤F¤@¨ÇÃö©ó¦r¨åª«¥óªº¸ê®Æ¡A§Ú¦³ÂI·d¤£¤ÓÀ´¡A¥i¥HÀ°§Ú¶}¥Ü¶Ü
            À°§Ú¸Ñ´b¤U­±³o¬q¶Ü
    Option Explicit
Sub Ex()
    Dim Rng As Range, d As Object, i As Variant, A As String
    Set d = CreateObject("scripting.dictionary")
    Set Rng =¤u§@ªí1.Range("a1").CurrentRegion
    For i = 2 To Rng.Rows.Count
        A = Rng(i, 1) & "-" & Rng(i, 2)
        If d.EXISTS(A) Then   '¦r¨åª«¥óªº(key­È)¦s¦b¶Ç¦^True
            Set d(A) = Union(Rng.Rows(i), d(A)) ==========¡H¡H
        Else
            Set d(A) = Rng.Rows(i)   ==========¡H¡H

        End If
    Next
    For Each i In d.KEYS  ==========¡H¡H

        If d(i).Rows.Count = 1 And InStr(d(i).Cells(3), "¨ú®ø") = 0 Then
            d(i).Delete xlUp
        ElseIf d(i).Rows.Count > 1 Or d(i).Areas.Count > 1 Then
            d(i).Delete xlUp

        End If
    Next
End Sub

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

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (93.67 KB)

2023-4-19 16:29

°õ¦æµ²ªG:

¤U¸ü (88.81 KB)

2023-4-19 16:29

Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, TT, T1$, T2$, T3$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([C2], Cells(Rows.Count, "A").End(3)): Brr = xR
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T1 & "|" & T2
   If Y(TT) <> "¦¨¥\" Then Y(TT) = T3: Y(TT & "|r") = i
Next
For Each TT In Y.keys
   If TT Like "*|r" Or Y(TT) = "¦¨¥\" Then GoTo i00
   R = R + 1: For j = 1 To 3: Brr(R, j) = Brr(Y(TT & "|r"), j): Next
i00: Next
If R = 0 Then GoTo i01
xR.Offset(1, 0).ClearContents: xR.Resize(R, 3) = Brr
i01: Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub