| ©«¤l2035 ¥DÃD24 ºëµØ0 ¿n¤À2031 ÂI¦W0  §@·~¨t²ÎWin7 ³nÅ骩¥»Office2010 ¾\ŪÅv100 ©Ê§O¨k µù¥U®É¶¡2012-3-22 ³Ì«áµn¿ý2024-2-1 
 | 
                
| ¦^´_ 5# Michelle-W ½Æ»s¥N½XSub Ex()
    Dim rng As Range, dic As Object
    Dim r As Long, txt As String
    
    r = [A2].End(xlDown).Row
    Range("$A$1:$G$" & r).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
    
    Set dic = CreateObject("scripting.dictionary")
    For Each rng In Range("A2", [A2].End(xlDown))
         If Not dic.exists(CStr(rng.Value)) Then dic(CStr(rng.Value)) = ""
        If rng.Offset(, 2) <> "" Or rng.Offset(, 3) <> "" Or rng.Offset(, 4) <> "" Or rng.Offset(, 5) <> "" Or rng.Offset(, 6) <> "" Then
            txt = Left(rng.Offset(, 2) & "          ", 10) & Left(rng.Offset(, 3) & "          ", 10) & _
                  Left(rng.Offset(, 4) & "          ", 10) & Left(rng.Offset(, 5) & "          ", 10) & Left(rng.Offset(, 6) & "          ", 10)
        Else
            txt = ""
        End If
        
        If txt <> "" Then dic(CStr(rng.Value)) = txt
     Next
    
    For r = Range("A2").End(xlDown).Row To 2 Step -1
        If Cells(r, 3) <> "" Or Cells(r, 4) <> "" Or Cells(r, 5) <> "" Or Cells(r, 6) <> "" Or Cells(r, 7) <> "" Then
            txt = Left(Cells(r, 3) & "          ", 10) & Left(Cells(r, 4) & "          ", 10) & _
              Left(Cells(r, 5) & "          ", 10) & Left(Cells(r, 6) & "          ", 10) & Left(Cells(r, 7) & "          ", 10)
        Else
            txt = ""
        End If
         If txt <> dic(CStr(Cells(r, 1).Value)) Then Rows(r).EntireRow.Delete
    Next
End Sub
    | 
 |