Question

所以我基本上想要从一个工作表中取出一个范围并删除重复项，保存该范围，没有重复，作为我的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

从 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

Answer 2

我认为Jean-Claude有一个很好的建议：复制整个范围，然后在目标工作表上执行.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+）中存在mopes超过16,384个唯一值，则会失败。

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

2 个答案: