關(guān)于剔除重復

pureshadow

這個問題曾經(jīng)被無數(shù)個人問，解決的方法也是無數(shù)個。
我在這里擺個擂：

征剔除重復的方法。

要求：
1、技巧、函數(shù)、VBA不限，但請注明。
2、如果有可能就用圖來說明，以方便初學者。

[ 本帖最后由 pureshadow 于 2008-3-24 16:36 編輯 ]

pureshadow

我先來一個——技巧法：高級篩選
位置在：數(shù)據(jù)-篩選-高級篩選
把“選擇不重復記錄”勾上。

jx1680000

jx1680000

jx1680000

'利用高級篩選代碼就一句話
Sub 在B列中提取A列中的不重復項()
        Sheets("test").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), unique:=True
End Sub



Sub 不重復記錄()
    '這里的序列是沒有標題的;此命令只用于test表,A列
    Application.ScreenUpdating = False
    '關(guān)閉屏幕轉(zhuǎn)換
    With Sheets("test")
        .Range("A:A").Sort Key1:=Range("A1"), Order1:=xlDescending
        '對序列降序排序
        Set currentcell = Range("A1")
        Do While Not IsEmpty(currentcell)
            Set nextcell = currentcell.Offset(1, 0)
            If nextcell.Value = currentcell.Value Then
                currentcell.EntireRow.Delete
            End If
            Set currentcell = nextcell
        Loop
    End With
End Sub

tanhong

VBA刪除重復項，只是不是很完善，得麻煩你多點幾次，直到?jīng)]有重復項哦，點出來的快樂，哈哈........
Sub 刪除重復()
Dim Lrow As Long
Dim I As Integer
Dim myCount
   Lrow = Sheets("sheet1").[A65536].End(xlUp).Row
   For I = 2 To Lrow
      myCount = Application.CountIf(Sheet1.Range("A2:A" & Lrow), Sheets("sheet1").Cells(I, 1))
      If myCount > 1 Then
         Sheets("sheet1").Cells(I, 1).Delete
      End If
   Next I
End Sub




實例樣本：

[ 本帖最后由 tanhong 于 2008-3-24 20:30 編輯 ]

tanhong

以上代碼就當拋磚引玉，希望后面能出現(xiàn)更多精彩

huangqinyong

[:11]

pureshadow

事實上，數(shù)據(jù)透視表也不失為一個好辦法，不僅可以一下子剔除重復，還可以列出每項重復了多少。

[ 本帖最后由 pureshadow 于 2008-3-24 23:40 編輯 ]

huangqinyong

原帖由 pureshadow 于 2008-3-24 23:35 發(fā)表
事實上，數(shù)據(jù)透視表也不失為一個好辦法，不僅可以一下子剔除重復，還可以列出每項重復了多少。

有道理，用數(shù)據(jù)透視表操作簡便快捷