在Excel中删除单元格中的重复文本

我想知道如何删除单元格中重复的名称/文本。 例如

Jean Donea Jean Doneasee RL Foye RL Foyesee JE Zimmer JE Zimmersee RP Reed RP Reedsee DE Munson DE Munsonsee 

当用谷歌search，我偶然发现一个macros/代码，就像：

 Function RemoveDupes1(pWorkRng As Range) As String 'Updateby20140924 Dim xValue As String Dim xChar As String Dim xOutValue As String Set xDic = CreateObject("Scripting.Dictionary") xValue = pWorkRng.Value For i = 1 To VBA.Len(xValue) xChar = VBA.Mid(xValue, i, 1) If xDic.exists(xChar) Then Else xDic(xChar) = "" xOutValue = xOutValue & xChar End If Next RemoveDupes1 = xOutValue End Function 

macros正在工作，但它正在比较每个字母，如果它发现任何重复的字母，它正在消除。

当我使用这些名字的代码时，结果有点像这样：

 Jean Dos RL Foyes JE Zimers RP edsDEMuno 

通过查看结果，我可以发现它不是我想要的，但我不知道如何更正代码。

所需的输出应该如下所示：

  Jean Donea RL Foye JE Zimmer RP Reed 

有什么build议么？

提前致谢。

Answer 1

input

通过图像上的input：

结果

Debug.Print输出

正则expression式

可以使用正则expression式在单元上dynamic迭代，以作为查找工具。 所以它只会提取最短的匹配。 \w*( OUTPUT_OF_EXTRACTELEMENT )\w* ，例如： \w*(Jean)\w*

正则expression式的引用必须启用 。

码

 Function EXTRACTELEMENT(Txt As String, n, Separator As String) As String On Error GoTo ErrHandler: EXTRACTELEMENT = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1) Exit Function ErrHandler: ' error handling code EXTRACTELEMENT = 0 On Error GoTo 0 End Function Sub test() Dim str As String Dim objMatches As Object Set objRegExp = CreateObject("VBScript.RegExp") 'New regexp lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row For Row = 1 To lastrow str = Range("A" & Row) F_str = "" N_Elements = UBound(Split(str, " ")) If N_Elements > 0 Then For k = 1 To N_Elements + 1 strPattern = "\w*(" & EXTRACTELEMENT(CStr(str), k, " ") & ")\w*" With objRegExp .Pattern = strPattern .Global = True End With If objRegExp.test(strPattern) Then Set objMatches = objRegExp.Execute(str) If objMatches.Count > 1 Then If objRegExp.test(F_str) = False Then F_str = F_str & " " & objMatches(0).Submatches(0) End If ElseIf k <= 2 And objMatches.Count = 1 Then F_str = F_str & " " & objMatches(0).Submatches(0) End If End If Next k Else F_str = str End If Debug.Print Trim(F_str) Next Row End Sub 

请注意您可以replaceDebug.Print以写入目标单元格，如果它是列B到Cells(Row,2)=Trim(F_str)

说明

function

您可以使用此UDF ，它使用拆分函数来获取由空格（“”）分隔的元素。 所以它可以让每个元素在细胞上进行比较。

循环

它将从1循环到每个单元中的元素k的数量，从1 row到lastrow 。

正则expression式

正则expression式用于查找单元格上的匹配项，并使用每个匹配项中最短的元素join一个新string。

Answer 2

这个解决scheme的操作假定'see'（或其他一些三字母string）将始终在单元格值的末尾。 如果不是这种情况，那么这是行不通的。

 Function RemoveDupeInCell(dString As String) As String Dim x As Long, ct As Long Dim str As String 'define str as half the length of the cell, minus the right three characters str = Trim(Left(dString, WorksheetFunction.RoundUp((Len(dString) - 3) / 2, 0))) 'loop through the entire cell and count the number of instances of str For x = 1 To Len(dString) If Mid(dString, x, Len(str)) = str Then ct = ct + 1 Next x 'if it's more than one, set to str, otherwise error If ct > 1 Then RemoveDupeInCell = str Else RemoveDupeInCell = "#N/A" End If End Function