How to look for repeated rows and then delete one of them? requires VBA

问题

I was wondering if anyone knows how to delete repeated rows.. Say for example,

   A        B       C

1  1        3       4
2  2        6       9
3  TEST     1       2
4  TEST     1       2
5  Both     1
6  Hi               2
7  None     3       3
8  Loud     4       4

For the particular example above, TEST was repeated twice.. In some other cases, the name can be some other kinds such as NOON, Morning, etc.. And row 8 does not necessary be the last row. I have no idea of how to compare the rows to check for repeated names and then delete them away. I need to run a macro with this and so i will need VBA. If you know it, please share it with me.. Will be thankful!

Attempt for codes:

 Sub Macro1()

   Dim LastRow As Long, n As Long, rowstodelete As Long

    LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

      For n = 1 To LastRow

    With Worksheets("Sheet1").Cells(n, 1)
         If .Cells(n, 1) = .Cells(n + 1, 1) Then
           rowstodelete = Worksheets("Sheet1").Cells(n, 1)
           Rows(rowstodelete).Select
           Selection.Delete Shift:=xlUp
         End If
   End With
       Next n

 End Sub

Unfortunately, there were runtime error over at the .Cells(n, 1).. I have no idea why it is.. if you know something can share with me or modify it alittle. will be thankful!

回答1:

user1204868

It is recommended that when deleting rows, always do it in reverse mode. See this code. Also you do not need to select the cell before deleting. That will slow down your code :)

Sub Sample()
    Dim LastRowcheck As Long, n1 As Long

    With Worksheets("Sheet1")
        LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row

        For n1 = LastRowcheck To 1 Step -1
            If .Cells(n1, 1).Value = Cells(n1 + 1, 1).Value Then
               .Rows(n1).Delete
            End If
        Next n1
    End With
End Sub

Here is an even better and faster way.

Sub Sample()
    Dim LastRowcheck As Long, n1 As Long
    Dim DelRange As Range

    With Worksheets("Sheet1")
        LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row

        For n1 = 1 To LastRowcheck
            If .Cells(n1, 1).Value = Cells(n1 + 1, 1).Value Then
                If DelRange Is Nothing Then
                    Set DelRange = .Rows(n1)
                Else
                    Set DelRange = Union(DelRange, .Rows(n1))
                End If
            End If
        Next n1

        If Not DelRange Is Nothing Then DelRange.Delete
    End With
End Sub

FOLLOWUP

any idea why reverse row deletion is better? – franklin 29 secs ago

When you delete a row, your For loop messes up as you are targeting set number of rows. You have to then write extra line of code , as you did, to keep track of the rows that you deleted. It also slows down your code :) When you delete in reverse then you don't have to account for the deleted row as it falls out of the current running loop. This way your code is faster. But then like I mentioned above, if you are not using reverse row deletion then use the 2nd code that I gave. That is even faster.

One point that I would like to mention though. If you are using Excel 2007/2010 then the one line code that @brettdj suggested is the fastest :)

HTH

Sid

回答2:

Manual
Bill Jelen's website offers three non-VBA techniques

All Versions: Use the Unique Option in Advanced Filter
Xl 07/10: Use Conditional Formatting to Mark Duplicates
Xl 07/10: Use Remove Duplicates icon

For (3) the equivalent VBA would be something like this (for no headers)
ActiveSheet.Range("$A$1:$C$100").RemoveDuplicates Columns:=1, Header:=xlNo

Handling existing duplicates
My free Duplicate Master addin will let you

Select
Colour
List
Delete

duplicates on either cells, entire rows (which appears to be your question) or certain columns in a row

But more importantly it will let you run more complex matching than exact strings, ie

Case Insensitive / Case Sensitive searches
Trim/Clean data
Remove all blank spaces (including CHAR(160))
Run regular expression matches
Match on any combination of columns (ie Column A, all columns, Column A&B etc)

回答3:

I have attempted my code once again and it can work out well.. Thanks! I will share it here to answer similar questions in the future!

  Sub Macro1()

  Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long

  LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

  For n1 = 1 To LastRowcheck
    With Worksheets("Sheet1").Cells(n1, 1)
      If Cells(n1, 1) = Cells(n1 + 1, 1) Then
        Worksheets("Sheet1").Cells(n1, 1).Select
        Selection.EntireRow.Delete
     End If
   End With
  Next n1

  End Sub

回答4:

Easiest way to do this in VBA (in 2007 or higher):

Worksheet("Sheet1").Range("A1").CurrentRegion.RemoveDuplicates(Array(1, 2, 3))

Depending on your worksheet layout you might need to adjust Range("A1").CurrentRegion to your data range...

回答5:

I think we need to sort the data first before running this macro to remove the duplicates completely.

来源：https://stackoverflow.com/questions/9644453/how-to-look-for-repeated-rows-and-then-delete-one-of-them-requires-vba

标签

excel

excel-vba

vba