删除excel中单元格中的重复文本

Question

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

Jean Donea Jean Doneasee 
R.L. Foye R.L. Foyesee 
J.E. Zimmer J.E. Zimmersee 
R.P. Reed R.P. Reedsee  D.E. Munson D.E. Munsonsee 

在谷歌搜索时，我偶然发现了一个宏/代码，就像：

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

宏正在运行，但它正在比较每个字母，如果它找到任何重复的字母，它就会删除它。

当我在这些名称上使用代码时，结果有点像这样：

Jean Dos
R.L Foyes
J.E Zimers
R.P edsDEMuno

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

所需的输出应如下所示：

 Jean Donea
 R.L. Foye 
 J.E. Zimmer
 R.P. Reed 

有什么建议吗？

先谢谢。

Answer 1

此解决方案的运作假设是“看到＆＃39; （或其他一些三字母字符串）将始终位于单元格值的末尾。如果情况并非如此，那么这不会起作用。

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

Answer 2

输入

使用图像输入：

结果

Debug.Print输出

正则表达式

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

正则表达式的引用必须是enabled。

代码

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

  

请注意，您可以替换要在目标上写入的Debug.Print   单元格，如果是B列到Cells(Row,2)=Trim(F_str)

说明

功能

您可以使用此 UDF ，它使用Split Function获取以空格（“”）分隔的元素。因此它可以让每个元素在单元格上进行比较。

循环

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

正则表达式

正则表达式用于查找单元格上的匹配项，并使用每个匹配项的最短元素加入一个新字符串。