且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

删除所有行,如果在excel - VBA中重复

更新时间:2023-11-04 15:22:34

我喜欢Jeeped的代码,但它不是***的可读的。因此,这里是另一个解决方案。

I like the code from Jeeped, but it isn't the best readable one. Therefore, here is another solution.

Sub remDup()
Dim rng As Range, dupRng As Range, lastrow As Long, ws As Worksheet
Dim col As Long, offset As Long, found As Boolean

'Disable all the stuff that is slowing down
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Define your worksheet here
Set ws = Worksheets(1)

'Define your column and row offset here
col = 3
offset = 0

'Find first empty row
Set rng = ws.Cells(offset + 1, col)
lastrow = rng.EntireColumn.Find( _
                What:="", After:=ws.Cells(offset + 1, col)).Row - 1

'Loop through list
While (rng.Row < lastrow)
    Do
        Set dupRng = ws.Range(ws.Cells(rng.Row + 1, col), ws.Cells(lastrow, col)).Find( _
                What:=rng, LookAt:=xlWhole)
        If (Not (dupRng Is Nothing)) Then
            dupRng.EntireRow.Delete
            lastrow = lastrow - 1
            found = True
            If (lastrow = rng.Row) Then Exit Do
        Else
            Exit Do
        End If
    Loop

    Set rng = rng.offset(1, 0)

    'Delete current row
    If (found) Then
        rng.offset(-1, 0).EntireRow.Delete
        lastrow = lastrow - 1
    End If

    found = False
Wend

'Enable stuff again
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

它可以与多个副本配合使用,您可以定义一个行偏移量,定义您忽略多少行在列的开头。

It works with more than one duplicate and you can define an row offset, which defines how much rows you ignore at the beginning of the column.