清除（不删除）使用VBA复制并保留第一个条目

Question

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

如果我的表像下面的例子：

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公式这样创建一个新的列：

= IF（COUNTIF（$ A $ 1：A1，A1）= 1，A1，“”）

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

可以用VBA运行这个吗？

Answer 1

这是相当快：

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 

Answer 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