问题
Just to clarify : I don't want to remove duplicates rows, I want to remove Duplicate Cells within a row
So here's a classic address table, and in some row there's duplicate entries I need to remove those entries. Most of what I've seen in VBA is used to remove duplicates values within a column, but I can't find a way to remove duplicate values within a row.
Name | Address1 | Address2 | City | Country
Peter | 2 foobar street |2 foobar street | Boston | USA
And I want it to be like :
Name | Address1 | Address2 | City | Country
Peter | 2 foobar street | | Boston | USA
I've write a macro that will loop through all the rows and then every columns for each rows, but I have no clue as to how to spot duplicate within teh different cells within teh same row.
here's the code below:
Sub Removedupe()
Dim LastRow As Long
Dim LastColumn As Long
Dim NextCol As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For counterRow = 1 To LastRow
'I'm stuck here: how to remove a duplicate values within that row?
Next counterRow
End Sub
回答1:
Maybe this will solve your problem:
Sub RemoveDuplicatesInRow()
Dim lastRow As Long
Dim lastCol As Long
Dim r As Long 'row index
Dim c As Long 'column index
Dim i As Long
With ActiveSheet.UsedRange
lastRow = .Row + .Rows.Count - 1
lastCol = .Column + .Columns.Count - 1
End With
For r = 1 To lastRow
For c = 1 To lastCol
For i = c + 1 To lastCol 'change lastCol to c+2 will remove adjacent duplicates only
If Cells(r, i) <> "" And Cells(r, i) = Cells(r, c) Then
Cells(r, i) = ""
End If
Next i
Next c
Next r
End Sub
回答2:
Maybe this in your loop:
If Range("A1").Offset(counterRow,1) = Range("A1").Offset(counterRow,2) Then
Range("A1").Offset(counterRow,2).Clear
End If
回答3:
Probably the easiest would be with a dictionary. Read the current cell. If it is already in the dictionary then blank out the cell, otherwise add it to the dictionary.
Dim dict As New Scripting.Dictionary
For counterRow = 1 To LastRow
key = // get the current cell value
If Not dict.Exists(key) Then
dict.Add key, "1"
Else
// clear current cell
End If Next counterRow
More on dictionary here: Does VBA have Dictionary Structure?
PS: Note that my solution removes all duplicates, not just if they are in the 2nd and 3rd column as in your example.
回答4:
In your case, the duplicates are adjacent. To clear duplicates in either a single column or single row for this special case:
Sub qwerty()
Dim r As Range, nR As Long
Set r = Intersect(Cells(13, 1).EntireRow, ActiveSheet.UsedRange)
nR = r.Count
For i = nR To 2 Step -1
If r(i) = r(i - 1) Then
r(i) = ""
End If
Next i
End Sub
This code is an example for row #13
来源:https://stackoverflow.com/questions/22082680/remove-duplicate-cells-in-a-row