删除两列数据同时相同的重复数据

shentu88

删除两列数据同时相同的重复数据

lsdongjh

1. 
   
2. Sub Test()
   
3.     Dim lngRow As Long
   
4.     Dim arr As Variant
   
5.    
   
6.     lngRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
   
7.     arr = Sheet1.Range("B1:C" & lngRow)
   
8.    
   
9.     For lngRow = UBound(arr) To LBound(arr) + 1 Step -1
   
10.         If arr(lngRow, 1) = arr(lngRow - 1, 1) And arr(lngRow, 2) = arr(lngRow - 1, 2) Then
    
11.             Rows(lngRow).Delete
    
12.         End If
    
13.     Next
    
14.    
    
15. End Sub
    

复制代码

tspliu

Sub Macro1()
    Cells.Select
    ActiveSheet.Range("$A$1:$G$22").RemoveDuplicates Columns:=Array(2, 3), Header _
        :=xlYes
End Sub

yaozong

1. Sub test()
   
2. Dim d, arr, s$, i&, j&, m&
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. arr = [A1].CurrentRegion.Value
   
5. For i = 1 To UBound(arr)
   
6.   s = arr(i, 2) & "+" & arr(i, 3)
   
7.   If Not d.exists(s) Then
   
8.     m = m + 1
   
9.     d(s) = m
   
10.     For j = 1 To UBound(arr, 2)
    
11.       arr(m, j) = arr(i, j)
    
12.     Next
    
13.   End If
    
14. Next
    
15. [A1].CurrentRegion.ClearContents
    
16. [A1].Resize(m, UBound(arr, 2)) = arr
    
17. End Sub

复制代码

shentu88

yaozong 发表于 2019-5-30 13:46

谢谢  非常感谢

lsc900707

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 1 To UBound(arr)
   
6.         s = arr(i, 2) & arr(i, 3)
   
7.         If Not d.exists(s) Then
   
8.             k = k + 1
   
9.             d(s) = k
   
10.             For j = 1 To UBound(arr, 2)
    
11.                 brr(k, j) = arr(i, j)
    
12.             Next
    
13.         End If
    
14.     Next
    
15.     If k > 0 Then
    
16.         Cells.ClearContents
    
17.         [a1].Resize(k, UBound(brr, 2)) = brr
    
18.     End If
    
19. End Sub

复制代码

lsc900707

测试参考附件：

shentu88

lsdongjh 发表于 2019-5-30 13:41

谢谢，非常感谢

shentu88

lsc900707 发表于 2019-5-30 13:58
测试参考附件：

谢谢，测试过了，非常感谢

shentu88

tspliu 发表于 2019-5-30 13:42
Sub Macro1()
    Cells.Select
    ActiveSheet.Range("$A$1:$G$22").RemoveDuplicates Columns:=Array( ...

谢谢，非常感谢