从范围中删除重复项而不删除数据

所以我基本上想从一个工作表中取出一个范围，并删除重复项，保存范围，没有重复，作为我的vba代码中的一些对象。 然后将该范围粘贴到另一个表格中。 但是，我不想在删除重复项时触碰Sheet1中的任何数据。

所以我有这样的东西：

Sub removeduplicates() Dim rng As Range Dim num As Long With Worksheets("Sheet1") Set rng = .Range("A2").End(xldown).RemoveDuplicates num = rng.Row End With With Worksheets("Sheet4") .UsedRange.ClearContents . . . 'Need some code here to essentially paste (w/transpose) in Sheet4 Row 1 columns A to 'to Row 1 column 'num' value. So similar to: .Range(.Cells(1,1), .Cells(1,num)) 

希望你明白我要做什么。 我可能需要使用数组或其他东西，但我只是卡住了。 而这个代码可能有很多错误。 它刚刚经过了很多玩耍。

谢谢。

Answer 1

我认为Jean-Claude有一个很好的build议：复制整个范围，然后在目标工作表上执行.RemoveDuplicates 。

如果您必须在内存中执行此操作，则甚至可以不使用.RemoveDuplicates方法：

 Sub removeduplicates() Dim r as Range Dim dictValues as Object Set dictValues = CreateObject("Scripting.Dictionary") For each r in Worksheets("Sheet1").Range("A2").End(xldown).Cells dictValues(r.Value) = r.Value Next With dictValues Worksheets("Sheet4").Range("A1").Resize(1, .Count).Value = .Keys() End With 

注意 ，如果在rng （对于Excel 2007+）中有16,384个唯一值，那么这将失败。

Answer 2

• 从Sheet1复制列A到Sheet4
• 删除Sheet4列A中的重复项
• 在Sheet4中将列A复制到行＃1

。

 Sub removeduplicates() Dim rng As Range Dim s1 As Worksheet, s4 As Worksheet Set s1 = Sheets("Sheet1") Set s4 = Sheets("Sheet4") Dim num As Long s4.Cells.ClearContents num = s1.Cells(Rows.Count, 1).End(xlUp).Row s1.Range("A2:A" & num).Copy s4.Range("A2") s4.Range("A:A").removeduplicates Columns:=1 num = s4.Cells(Rows.Count, 1).End(xlUp).Row s4.Range("A1:A" & num).Copy s4.Range("B1").PasteSpecial Transpose:=True End Sub