简体   繁体   English

VBA在两列中删除重复项

[英]VBA remove duplicates in two columns

I want to use VBA to remove duplicates in two columns B and CEg when B1=B2 AND C1=C2, then B2 AND C2 data should be removed. 我想使用VBA在B1 = B2 AND C1 = C2时删除B和CEg两列中的重复项,然后应删除B2 AND C2数据。 But when B1!=B2 AND C1=C2, B2 AND C2 should not be removed as B2 has different value from B1. 但是,当B1!= B2 AND C1 = C2时,不应删除B2 AND C2,因为B2的值与B1不同。 Right now I'm using the below code, but it does not do the right thing as I want..it removes the duplicate data in column C only. 现在我正在使用下面的代码,但是它并没有做我想要的正确的事情。它仅删除C列中的重复数据。

Sub ()

Dim rCell As Range

With Worksheets("Sheet1")
  For Each rCell In Range("B1:C20") 
  rCell.EntireColumn.RemoveDuplicates 1
  Next rCell
End With

End Sub

Anyone knows how to change the code to make it work properly? 有谁知道如何更改代码以使其正常工作?

Thanks in advance! 提前致谢!

i got you homie.... 我让你亲密的...

Sub RemoveDups_Copy(sSheet As String)
Dim vArray As Variant
Dim x As Long, y As Integer
Dim sTest As String

Worksheets(sSheet).Select
x = 1
Do While Cells(x + 1, 1) <> ""
x = x + 1
Loop

lastRow = x
If lastRow = 1 Then lastRow = 2
lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

ReDim vArray(1 To lastRow, 1 To lastColumn)
Set dRemove = CreateObject("Scripting.Dictionary")
Set dRemoveIndex = CreateObject("Scripting.Dictionary")


For x = 2 To lastRow
    sTest = ""
    For y = 1 To lastColumn
        sTest = sTest & "|" & Cells(x, y).Text
    Next y
    If dRemove(sTest) = "Remove" Then dRemoveIndex(x) = "Remove"
    dRemove(sTest) = "Remove"
Next x

i = 0
For x = 1 To lastRow
    If dRemoveIndex(x) <> "Remove" Then
        i = i + 1
        For y = 1 To lastColumn
            vArray(i, y) = Cells(x, y).Text
        Next y
    End If
Next x

Range(Cells(2, 1), Cells(lastRow, lastColumn)).ClearContents
Call RemoveDups_Paste(1, 1, vArray)

End Sub

Sub RemoveDups_Paste(x As Integer, y As Integer, Arr As Variant)
    Set Rng = Range(Cells(x, y), Cells(UBound(Arr, 1) - LBound(Arr, 1) + x, UBound(Arr, 2) - LBound(Arr, 2) + y))
    Rng.Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) = Arr
End Sub

This records all the original (or non-dup'd) data into an array, clears the data then pastes it over as a range instead of individually. 这会将所有原始(或非重复)数据记录到一个数组中,清除数据,然后将其粘贴为一个范围,而不是单独粘贴。 Should run fast. 应该跑得快。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM