Question

只是为了澄清：我不想删除重复行，我想删除行中的重复单元格

所以这是一个经典的地址表，在某些行中有重复的条目我需要删除这些条目。我在VBA中看到的大部分内容都用于删除列中的重复值，但我找不到删除行中重复值的方法。

Name  |        Address1 |       Address2 |    City |    Country

Peter | 2 foobar street |2 foobar street |  Boston |    USA

我希望它像：

Name  |         Address1 |  Address2 |   City  |    Country

Peter | 2 foobar street  |           |  Boston |    USA

我已经编写了一个宏，它将循环遍历所有行，然后遍历每行的每一列，但我不知道如何在同一行内的不同单元格中发现重复。

这是以下代码：

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

Answer 1

也许这会解决您的问题：

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

Answer 2

也许这在你的循环中：

If Range("A1").Offset(counterRow,1) = Range("A1").Offset(counterRow,2) Then
    Range("A1").Offset(counterRow,2).Clear
End If

Answer 3

最简单的可能是字典。读取当前单元格。如果它已经在字典中，则将单元格空白，否则将其添加到字典中。

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

更多关于词典的信息： Does VBA have Dictionary Structure?

PS：请注意，我的解决方案会删除所有重复项，而不仅仅是它们位于第2列和第3列中，如示例所示。

Answer 4

在您的情况下，重复项是相邻的。要清除此特殊情况下单个列或单个行中的重复项：

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

此代码是第13行的示例

连续删除重复单元格

4 个答案: