½Ð°ª¤âÀ°¦£Å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        ¨ú®ø

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

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