清除(不删除)重复并使用VBA保留第一个条目

时间:2014-04-10 23:09:58

标签: excel vba excel-vba

我想清除表格第一列中的所有重复值,但保留第一个条目。

如果我的表格如下例所示:

    A          B          C
    001        Katy   Argentina
    002        Katy   Argentina
               Katy   Argentina
    002        Katy   Argentina
    004        Katy   Argentina
    001        Katy   Argentina

期望的结果:

    A          B          C
    001        Katy   Argentina
    002        Katy   Argentina
               Katy   Argentina
               Katy   Argentina
    004        Katy   Argentina
               Katy   Argentina

我的第一个解决方案是创建一个带有Countif Formula的新列,如下所示:

= IF(COUNTIF($ A $ 1:A1,A1)= 1,A1, “”)

这个工作非常好但是我的表包含几列和300,000行,所以当我运行这个过程大约需要3个小时。

是否可以使用VBA运行它?

2 个答案:

答案 0 :(得分:2)

考虑:

Sub ClearV()
    Dim N As Long
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = N To 2 Step -1
        Set rlook = Range(Cells(i - 1, "A"), Cells(1, 1))
        If Application.WorksheetFunction.CountIf(rlook, Cells(i, "A")) > 0 Then
            Cells(i, "A").Clear
        End If
    Next i
End Sub

答案 1 :(得分:2)

这很快:

Sub Tester()
    Dim t
    'create some repeating data
    With Range("A2:A300000")
        .Formula = "=ROUND(RAND()*1000,0)"
        .Value = .Value
    End With

    t = Timer
    ClearDups Range("A2:A300000")  'remove the dups
    Debug.Print Timer - t & " sec"  ' < 1sec
End Sub


Sub ClearDups(rng As Range)
    Dim data, dict As Object, r As Long, nR As Long, tmp
    Set dict = CreateObject("scripting.dictionary")

    Set rng = rng.Columns(1) 'make sure only one column...
    data = rng.Value      'grab data in an array
    nR = UBound(data, 1)
    'loop over the array
    For r = 1 To nR
        tmp = data(r, 1)
        If Len(tmp) > 0 Then
        If dict.exists(tmp) Then
            data(r, 1) = "" 'seen this value before - clear it
        Else
            dict.Add tmp, 1  'first time for this value
        End If
        End If
    Next r
    rng.Value = data 'dump the array back to the range
End Sub