Question

我有一个Range对象引用工作表上的列。此列包含混合数据类型（数字，文本和一些其他内容）。

我想删除列中的重复项：

rge.RemoveDuplicates Columns:=1, Header:xlNo

但由于混合数据类型，这不能正确删除所有重复项。

我知道混合数据类型是个问题，因为在尝试从这些值的副本中删除重复项之前，使用TEXT($REF, "0")手动转换单元格是成功的。

如何使用文本等效项替换范围内的所有值？

我已经尝试过显而易见的事了：

rge = rge.Text
rge.Value = rge.Text

但没有成功。

请注意，迭代不是一个选项;我正在处理数万行数据，单独写入单元格的性能损失太高了。我需要能够同时在整个范围内操作的东西。

（如果事实证明迭代是唯一的解决方案，使用.RemoveDuplicates进行第一次传递实际上会更快，对数据进行排序，然后在n时间内手动取出其余的数据。）

编辑：其他信息

如果我复制并粘贴不包含重复项的范围子集，然后手动运行“删除重复项”，则会删除重复值。

但是，如果我复制范围的一个子集也包含数字，则重复项不删除，即使重复项本身不是数字。

我的猜测（这只是一个猜测）是内部excel对混合数据类型值使用不同的比较算法，而不是纯文本值。

最低工作示例：https://dl.dropboxusercontent.com/u/1402749/dups.xlsx

Answer 1

我没有尝试使用RemoveDuplicates方法，因为它似乎对你不起作用。

我使用字典对象来完成脏工作并帮助确保唯一性。基于此示例的（明显）成功，我不确定您是否需要担心将值转换为文本。此迭代仅使用值，然后重新写入范围。如果您需要其他格式，请澄清：）

Sub Test()
Dim d As Object 'Scripting.Dictionary
                ' requires reference to Microsoft Scripting Runtime if you
                ' want to use early-binding
Dim rng As Range
Dim cl As Variant
Dim var As Variant

'#Define our range
Set rng = Range("A1:A22")
'#Store values in an array
var = rng.Value
'#Instantiate our dictioanry object
Set d = CreateObject("Scripting.Dictionary")
'#store unique vals in the dictionary
For Each cl In var
    d(cl) = cl
Next

'#Clear the original range
rng.Clear
'#Put the unique vals in to the range
rng.Resize(UBound(d.Keys) + 1).Value = Application.Transpose(d.Keys())

Set d = Nothing
End Sub

在样本数据上，我最终得到17个唯一值：

enter image description here

Answer 2

Selection.NumberFormat =＆＃34; @＆＃34;

我认为rge.NumberFormat =＆＃34; @＆＃34;会工作

Answer 3

我相信这将提供您正在寻找的结果。将此函数插入VBA编辑器。

Public Sub ConvertToText()

    Dim c As Range
    Dim a As Areas
    Dim v As Variant

    Set c = Selection
    Set a = c.Areas

    If a.Count > 1 Then
        ' IF DESIRED YOU CAN EXTEND THE LOGIC FOR MULTIPLE AREAS | CURRENT FUNCTION DOES NOT SUPPORT
        MsgBox "Select one continuous range.", vbCritical, "Error"
        Exit Sub
    End If

    v = WorksheetFunction.Transpose(WorksheetFunction.Transpose(c.Value))

    c.Clear
    c.NumberFormat = "@"
    c = v

End Sub

Answer 4

我认为您使用RemoveDuplicates语法存在问题。

尝试：

rge.RemoveDuplicates Columns:=Array(1), Header:=xlNo

我建议运行其他代码，首先将格式标准化为文本。这种语法对我来说很好。

Answer 5

我不知道为什么removeduplicates不起作用。但我不会处理你的样本数据。作为＆＃34;解决方法＆＃34;我建议尝试使用高级过滤器。唯一的缺点是它总是将第一行视为标题，因此您可能需要对此进行补偿。这是一个适用于您的样本数据的例程。我选择复制到新目的地，然后覆盖原始目的地，但您可能希望使用不同的方案。

此外，如果它适用于您，您可能希望在宏运行时禁用屏幕更新。

顺便说一下，例程也适用于常规格式化和混合数字和文本数据。可能不需要将所有内容都转换为文本。

Sub RemDups()
    Dim R As Range
    Dim rDest As Range

Set R = Range("a1", Cells(Rows.Count, "A").End(xlUp))

Set rDest = Range("D1")
rDest.EntireColumn.Clear

R.AdvancedFilter xlFilterCopy, , rDest, True

R.EntireColumn.Clear
Set rDest = Range(rDest, Cells(Rows.Count, rDest.Column).End(xlUp))
rDest.Copy R(1)
rDest.Clear

End Sub

Answer 6

你可以去看看：

如果您的数据大小<= 30k行：与 Excel的RemoveDuplicates

相比，错过时间约0.2秒

Dim arr As Variant, i As Long
'~~> pass range values to array
With SheetCodename '~~> Change to suit
    arr = Application.Transpose(.Range("A1", .Range("A" & .Rows.Count).End(xlUp)))
End With 
'~~> use Dictionary to remove dupes
With CreateObject("Scripting.Dictionary")
    For i = LBound(arr) To UBound(arr)
        .Item(CStr(arr(i))) = CStr(arr(i))
    Next
    SheetCodename.Range("A:A").ClearContents '~~> Clear source range
    '~~> Return unique items to range
    SheetCodename.Range("A1", "A" & .Count) = Application.Transpose(.Items)
End With

我在您的样本数据上对此进行了测试，并返回了17个唯一值但是对于较大的数据集，由于Excel内存的缺点，这可能会失败。

<强> EDIT1：
我真的有兴趣让这项工作在100k行以上更多。
然后我偶然发现THIS以下是我想出来的 测试的实际数据数量： 168091

Dim rng As Range, cel As Range
Dim arr() As Variant, i As Long, key, start

start = Timer
With Sheet4
    Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    rng.RemoveDuplicates 1, xlNo
End With
Debug.Print Timer - start '3.585938 sec

start = Timer
With Sheet2
    Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With
'~~> Use Dictionary to remove duplicates
With CreateObject("Scripting.Dictionary")
    '~~> need to loop through range since Array have limitations as well
    For Each cel In rng
        .Item(CStr(cel.Value2)) = CStr(cel.Value2)
    Next
    '~~> array limit workaround
    ReDim arr(.Count, 2): i = 0
    For Each key In .Keys
        arr(i, 0) = .Item(key)
        i = i + 1
    Next
    '~~> Return unique items to range
    Sheet2.Range("A:A").ClearContents
    Sheet2.Range("A1", "A" & .Count) = arr
End With
Debug.Print Timer - start '5.257813 sec

结果与使用 Excels RemoveDuplicates 相同（我的意思是唯一输出）。
性能差异为1.671875秒，但对我而言仍然可以控制。

Answer 7

您的示例数据集已经格式化为文本...我将多行更改为数字格式，并且能够使用以下代码删除重复项（不将所有内容格式化为文本）：

Sub RemoveDuplicates()

Dim r As Range
Dim w As Worksheet

Set w = ActiveSheet
Set r = w.Range("A1:A100000")

r.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r.Offset(0, 1), Unique:=True

End Sub

上面的代码将唯一值放在B列中，因此您必须根据需要对其进行修改。如果您希望数据保留在A列中，则可以创建临时表以放置唯一值，删除原始数据集，然后将唯一值移回原始工作表。

上面的代码假设您有一个数据集标题。我也不知道这对大型数据集有多好......所以你可能需要做一些测试，看它是否适合你。

修改

我刚刚在100K行上进行了测试，花了大约50秒才完成......所以我猜这个解决方案不可行。我刚看到你选择了大卫的答案。 :)我会留下这个，以防将来帮助其他人。

修改2

在我发布我之前，我错过了Ron的回答。我们使用相同的功能，但他的答案比我的功能更多。

如何将范围中的所有值转换为文本？

7 个答案: