如何用VBA删除重复行?

ning84

zez

Sub Macro1()
    For N = [a65536].End(xlUp).Row To 2 Step -1
        If Cells(N, 1) = Cells(N - 1, 1) Then Rows(N).Delete Shift:=xlShiftUp
    Next
End Sub

jnsxmt

删除重复行.zip   请审阅

ning84

zez 发表于 2015-8-8 11:31
Sub Macro1()
    For N = [a65536].End(xlUp).Row To 2 Step -1
        If Cells(N, 1) = Cells(N - 1, ...

谢谢回复。
对于多重复行，需要多次运行此删除代码

ii+1绕过要删除的重复行
DesgRng(ii + 1)

代码如下,代码需要进一步优化。

1. Private Sub DelReplRow1()
   
2.    Dim Rng As Range, oRng As Range, oRng1 As Range, oRng2 As Range, DesgRng As Range
   
3.    
   
4.    Dim DesgRngStr
   
5.       ''
   
6.       DesgRngStr = "A3:A45"
   
7.    
   
8.          Set Sht = Application.ActiveSheet
   
9.          ''
   
10.          Col = Sht.Range("AF2").End(xlToLeft).Column
    
11.          ''
    
12.          Set DesgRng = Sht.Range(DesgRngStr)
    
13.          For ii = 1 To DesgRng.Rows.Count
    
14.             If DesgRng(ii, 1) = DesgRng(ii + 1, 1) Then
    
15.                Set oRng = Sht.Rows(DesgRng(ii + 1).Row)
    
16.                Sht.Rows(oRng.Address).Select
    
17.                oRng.Delete Shift:=xlShiftUp
    
18.             End If
    
19.          Next ii
    
20.          
    
21. 
    
22. End Sub
    

复制代码

ning84

找到解决方法了。正向删除不成立 ，只能反向删除，

1. Private Sub DelReplRow1()
   
2.    Dim Rng As Range, oRng As Range, oRng1 As Range, oRng2 As Range, DesgRng As Range
   
3.    
   
4.    Dim DesgRngStr, Str1, Str2
   
5.       ''
   
6.       DesgRngStr = "A3:A45"
   
7.    
   
8.          Set Sht = Application.ActiveSheet
   
9.          ''
   
10.          Col = Sht.Range("AF2").End(xlToLeft).Column
    
11.          ''
    
12.          Set DesgRng = Sht.Range(DesgRngStr)
    
13.          For ii = DesgRng.Rows.Count To 1 Step -1
    
14.             Str1 = DesgRng(ii, 1)
    
15.             Str2 = DesgRng(ii - 1, 1)
    
16.             If Str1 <> "" Then
    
17.                If Str1 = Str2 Then
    
18.                   Set oRng = Sht.Rows(DesgRng(ii - 1).Row)
    
19.                   Sht.Rows(oRng.Address).Select
    
20.                   oRng.Delete Shift:=xlShiftUp
    
21.                End If
    
22.             End If
    
23.          Next ii
    
24.          
    
25. 
    
26. End Sub
    
27. 
    

复制代码

GUOJIS

zez 发表于 2015-8-8 11:31
Sub Macro1()
    For N = [a65536].End(xlUp).Row To 2 Step -1
        If Cells(N, 1) = Cells(N - 1, ...

谢谢老师，很管用的代码