刪除列中的重複單元格內容

我試圖刪除單個列中重複單元格的內容。我想保留條目的第一個匹配項，但刪除它下面的所有重複項。刪除列中的重複單元格內容

我只能找到刪除整行並且不清除內容的代碼。

Sub Duplicate() 

With Application 
    ' Turn off screen updating to increase performance 
    .ScreenUpdating = False 
    Dim LastColumn As Integer 
    LastColumn = Cells.Find(What:="*", After:=Range("U1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1 
    With Range("U1:U" & Cells(Rows.Count, 1).End(xlUp).Row) 
     ' Use AdvanceFilter to filter unique values 
     .AdvancedFilter Action:=xlFilterInPlace, Unique:=True 
     .SpecialCells(xlCellTypeVisible).Offset(0, LastColumn - 1).Value = 1 
     On Error Resume Next 
     ActiveSheet.ShowAllData 
     'Delete the blank rows 
     Columns(LastColumn).SpecialCells(xlCellTypeBlanks).Cells.Clear 
     Err.Clear 
    End With 
    Columns(LastColumn).Clear 
    .ScreenUpdating = True 
End With 

End Sub

來源

2017-01-13 R S

只是使用任何算法顯示檢測重複單元格，然後，而不是使用'wholerow.delete'方法，使用'cells.clear'方法。如果它不起作用，請發佈您的代碼。 –

@RonRosenfeld我只能找到刪除所有條目並且不保留第一個出現的代碼。我編輯了我的帖子以顯示我正在嘗試使用的代碼。 –

我已經發布了一些可以使用的東西，它使用了不同的算法。高級過濾器似乎不適合您的目的。 –

這是一種方法。我們開始在塔的底部，向上的工作：

Sub RmDups() 
    Dim A As Range, N As Long, i As Long, wf As WorksheetFunction 
    Dim rUP As Range 

    Set A = Range("A:A") 
    Set wf = Application.WorksheetFunction 

    N = Cells(Rows.Count, "A").End(xlUp).Row 

    For i = N To 2 Step -1 
     Set rUP = Range(Cells(i - 1, 1), Cells(1, 1)) 
     If wf.CountIf(rUP, Cells(i, 1).Value) > 0 Then Cells(i, 1).Clear 
    Next i 
End Sub

我們上面的檢查，看看是否有高於我們的任何副本，如果是清除細胞。之前：

後：

編輯＃1：

對於列u：

Sub RmDupsU() 
    Dim U As Range, N As Long, i As Long, wf As WorksheetFunction 
    Dim rUP As Range 

    Set U = Range("U:U") 
    Set wf = Application.WorksheetFunction 

    N = Cells(Rows.Count, "U").End(xlUp).Row 

    For i = N To 2 Step -1 
     Set rUP = Range(Cells(i - 1, "U"), Cells(1, "U")) 
     If wf.CountIf(rUP, Cells(i, "U").Value) > 0 Then Cells(i, "U").Clear 
    Next i 
End Sub

來源

2017-01-13 13:44:35

這對列A當我嘗試它的工作..我試圖編輯它的列U通過替換A與U，但它仍然只適用於列A.不知道哪部分代碼需要更改..似乎是儘管我們接近。 –

@RS見我的**編輯＃1 ** –

謝謝你完美的作品。 –

這是一個可以工作的例程。它可以大大如有必要，可以加快：

編輯：我改列數列字母，在那裏你會需要的，如果你想比「A」

Option Explicit 
Sub ClearDups() 
    Dim R As Range 
    Dim I As Long 
    Dim COL As Collection 

Set R = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 
Set COL = New Collection 

On Error Resume Next 
For I = 1 To R.Rows.Count 
    COL.Add Item:=R(I, 1), Key:=CStr(R(I, 1)) 
    Select Case Err.Number 
     Case 457 'Duplicate test (Collection object rejects duplicate keys) 
      Err.Clear 
      R(I, 1).ClearContents 
     Case Is <> 0 'unexpected error 
      MsgBox Err.Number & vbLf & Err.Description 
    End Select 
Next I 
On Error Goto 0 


End Sub

其他的列進行更改

來源

2017-01-13 13:53:59

我0.02美分

Sub main() 
    Dim i As Long 
    With Range("A1", Cells(Rows.Count, 1).End(xlUp)) 
     For i = 1 To .Rows.Count - 1 
      .Range(.Cells(i + 1, 1), .Cells(.Rows.Count)).Replace what:=.Cells(i, 1).Value, replacement:="", lookat:=xlWhole 
     Next i 
    End With 
End Sub

來源

2017-01-13 14:33:56 user3598756

'This code crisply does the job of clearing the duplicate values in a given column 
    Sub jkjFindAndClearDuplicatesInGivenColumn() 
     dupcol = Val(InputBox("Type column number")) 
     lastrow = Cells(Rows.Count, dupcol).End(xlUp).Row 
     For n = 1 To lastrow 
     nval = Cells(n, dupcol) 
      For m = n + 1 To lastrow 
      mval = Cells(m, dupcol) 
       If mval = nval Then 
       Cells(m, dupcol) = "" 
       End If 
      Next m 
     Next n 
    End Sub

來源

2017-01-16 05:40:19

刪除列中的重複單元格內容

回答

相關問題