Removing Duplicates from a Column but make columns

2019-07-25 02:46发布

So I am trying to remove duplicate IDs from a column and paste the outcome onto another sheet. My current workaround is to just copy the entire column to the new sheet first and remove the duplicates there but that is very taxing right now as there are 60k rows and I want to now do this for multiple columns.

Question: Is there a better way to do this so I dont have to copy the column over first.

Here is my current code.

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Test.xlsx")
Set ws = wb.Worksheets(1)
Set ws2 = wb.Worksheets(4)

ws.Range("A1:A" & rowz) = ws2.Range("A1:A" & rowz)

with ws2
Set CtrlID = ws2.Range("A1:A" & rowz)
CtrlID.RemoveDuplicates Columns:=1, Header:=xlYes
end with

1条回答
Anthone
2楼-- · 2019-07-25 03:19

If you're having trouble implementing the Dictionary approach, you could try this:

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim dict as Object
Dim r as Range
Set wb = Workbooks("Test.xlsx")
Set ws = wb.Worksheets(1)
Set ws2 = wb.Worksheets(4)

Set dict = CreateObject("Scripting.Dictionary")

'Assign each value to the dictionary
' overwrites existing values and ensures no duplicates
For each r in ws.Range("A1:A" & rowz).Cells
    dict(r.Value) = r.Value
Next

'## Put the dictionary in to the other worksheet:
ws2.Range("A1").Resize(Ubound(dict.Keys) + 1, 1).Value = Application.Transpose(dict.Keys)

Set dict = Nothing

HOWEVER I don't really see a reason to re-invent the wheel. You could run some tests to see which is faster.

查看更多
登录 后发表回答