从列中删除重复的内容,但是使用VBA将另一个表上的列作为结果

时间:2021-02-08 20:56:55

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.

因此,我试图从列中删除重复的id,并将结果粘贴到另一个表中。我现在的工作是先将整个列复制到新表单中,然后删除副本,但是现在非常繁重,因为有60k行,我现在想要为多个列做这个。

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 个解决方案

#1


1  

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.

然而,我并没有找到重新发明*的理由。您可以运行一些测试,看看哪个更快。

#1


1  

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.

然而,我并没有找到重新发明*的理由。您可以运行一些测试,看看哪个更快。