如何删除excel中单元格内逗号分隔的重复项？

我处理了一个非常长的Excel文件（最多11000行和7列），在单元格内有许多重复的数据。 我正在寻找一个macros来摆脱它，但找不到任何。

一个这样的细胞的例子：

Ciencias de laEducación，Educación，Pedagogía，Ciencias de laEducación，Educación，Pedagogía

它应该看起来像：

Ciencias de laEducación，Educación，Pedagogía

我怎么能摆脱成千上万的重复（更不用说额外的孤儿，逗号）？

Answer 1

此代码在我的机器上运行6秒，在@ SiddharthRout的机器上运行2秒:) （数据单元格A1:G20000 ：20000×7 = 140000非空单元格）

 Sub test2() Dim c, arr, el, data, it Dim start As Date Dim targetRange As Range Dim dict As Object Set dict = CreateObject("Scripting.dictionary") Application.ScreenUpdating = False Set targetRange = Range("A1:G20000") data = targetRange start = Now For i = LBound(data) To UBound(data) For j = LBound(data, 2) To UBound(data, 2) c = data(i, j) dict.RemoveAll arr = Split(c, ",") For Each el In arr On Error Resume Next dict.Add Trim(el), Trim(el) On Error GoTo 0 Next c = "" For Each it In dict.Items c = c & it & "," Next If c <> "" Then c = Left(c, Len(c) - 1) data(i, j) = c Next j Next i targetRange = data Application.ScreenUpdating = True MsgBox "Working time: " & Format(Now - start, "hh:nn:ss") End Sub 

---

你可以通过改变接下来的两行来稍微加快这段代码

 Dim dict As Object Set dict = CreateObject("Scripting.dictionary") 

至

 Dim dict As new Dictionary 

添加对库的引用后：转到工具 – >引用，然后select“Microsoft脚本运行时”

Answer 2

这是一个基本的例子

 Sub Sample() Dim sString As String Dim MyAr As Variant Dim Col As New Collection Dim itm sString = "Ciencias de la Educación,Educación,Pedagogía,Ciencias de la Educación,Educación,Pedagogía" MyAr = Split(sString, ",") For i = LBound(MyAr) To UBound(MyAr) On Error Resume Next Col.Add Trim(MyAr(i)), CStr(Trim(MyAr(i))) On Error GoTo 0 Next i sString = "" For Each itm In Col sString = sString & "," & itm Next sString = Mid(sString, 2) Debug.Print sString End Sub 

编辑

在Excel 2010中使用A1:G20000进行了testing和testing， A1:G20000充满了Ciencias de la Educación,Educación,Pedagogía,Ciencias de la Educación,Educación,Pedagogía

所用时间 ：2秒

码

 Sub Sample() Dim sString As String Dim MyAr As Variant, rngAr Dim Col As New Collection Dim itm Dim rng As Range Debug.Print "StartTime: " & Now Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:G20000") rngAr = rng.Value For i = LBound(rngAr) To UBound(rngAr) For j = LBound(rngAr, 2) To UBound(rngAr, 2) MyAr = Split(rngAr(i, j), ",") For k = LBound(MyAr) To UBound(MyAr) On Error Resume Next Col.Add Trim(MyAr(k)), CStr(Trim(MyAr(k))) On Error GoTo 0 Next k sString = "" For Each itm In Col sString = sString & "," & itm Next sString = Mid(sString, 2) rngAr(i, j) = sString Next j Next i ThisWorkbook.Sheets("Sheet1").Range("A1").Resize(20000, 7).Value = rngAr Debug.Print "EndTime: " & Now End Sub 

截图