公式来查看姓氏是否在单元格内重复并输出简化的string

我有一个数千个项目的清单，其中包含几个不同的名字，如下所示：

Mr P Thompson & Mrs S Thompson & Mr A Thompson Mr C Guy-Johnson & Mrs A Guye-Johnson & Miss J Guye-Johnson Mrs Fuller & Ms D Fuller & Dr KU Fuller Dr V Patel & Dr OO Patel Mr B Burden & Mr MP Wood & Ms C Pollock Mr PW Philips & Mrs PW Philips Dr D Watson & S Holmes Mr R Polanski & Mrs S Polanski Mr S Spielberg & Miss G Spielberg & Mrs T Spielberg 

有时姓氏是在细胞内重复，有时不是。

我想要build立一个公式来决定是否重复姓氏，并返回一个string，其中Salutations / Title和Inititals与Surname结尾，除非姓氏不同。

例如，

 - Mr S Spielberg & Miss G Spielberg & Mrs T Spielberg - Mr R Polanski & Mrs S Polanski 

会成为，

 - Mr S & Miss G & Mrs T Spielberg - Mr R & Mrs S Polanski 

但：

 - Mr B Burden & Mr MP Wood & Ms C Pollock - Dr D Watson & S Holmes 

会保持不变，因为姓氏是不同的

是否有可能用公式来做到这一点（而不是使用文本分列名称），我该怎么做？

感谢Philip

Answer 1

我相信巴里或洛瑞会提出一个聪明的公式:)但是，这是一个VBA的例子，可能只是解决你的老板的breathing问题;）

将此代码粘贴到模块中。 （ 仅在下面截图中的样本进行testing ）。 我冒昧地操纵一个单元格的值来考虑多个姓氏的匹配。 请参阅单元格A1

 Function GetNewNames(rng As Range) As String Dim MyAr() As String, tmpAr() As String Dim prevValue As String, sTmp As String, surName As String, sTemp As String Dim i As Long Dim col As New Collection Dim itm As Variant On Error GoTo Whoa: If Not rng Is Nothing Then prevValue = rng.Value If InStr(1, prevValue, "&") Then MyAr = Split(prevValue, "&") For i = 0 To UBound(MyAr) sTmp = Trim(MyAr(i)) If InStr(1, sTmp, " ") Then tmpAr = Split(sTmp, " ") surName = tmpAr(UBound(tmpAr)) Else surName = sTmp End If On Error Resume Next col.Add surName, Chr(34) & surName & Chr(34) On Error Resume Next Next i For Each itm In col For i = 0 To UBound(MyAr) sTmp = Trim(MyAr(i)) If InStr(1, sTmp, " ") Then tmpAr = Split(sTmp, " ") surName = tmpAr(UBound(tmpAr)) Else surName = sTmp End If If surName = itm Then If sTemp = "" Then sTemp = Trim(MyAr(i)) Else sTemp = Replace(sTemp & " & " & Trim(MyAr(i)), itm & " &", "&") End If End If Next i Next GetNewNames = sTemp Else GetNewNames = prevValue End If End If Exit Function Whoa: GetNewNames = "" End Function 

截图

Answer 2

在过去一周的这个任务中，我发现Excel MVP Aladin Akyurek 在这里用了这个优秀的公式，用来计算单元格中有多less个空格（用来决定是否需要首字母缩写，就好像没有Salutaion或名字，只有姓用来）

 =LEN(A1)-LEN(SUBSTITUTE(A1," ","")) 

在Ozgrid论坛 Jindon提出了这个正则expression式的解决scheme，给了我更多的鼓励打我的O'Reilly 正则expression式食谱再次：

 Sub test() Dim r As Range, txt With CreateObject("VBScript.RegExp") .Pattern = "(.* )?(\S{3,})( .* )(\2)( .*)?" For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp)) txt = r Do While .test(txt) txt = .Replace(txt, "$1$3$4$5") Loop r(, 2) = Application.Trim(txt) Next End With End Sub 

在VBA Express论坛上， SNB想出了这个可爱的CSE公式

 =SUBSTITUTE(A1,MID(A1,MAX((MID(A1,ROW(1:100),1)=" ")*ROW(1:100)),100),"")&MID(A1,MAX((MID(A1,ROW(1:100),1)=" ")*ROW(1:100)),100) 

还在VBA Express论坛上， mdmackillop想出了这个巧妙的思想：

 =SUBSTITUTE(A1,TRIM(RIGHT(SUBSTITUTE(TRIM(A1)," ",REPT(" ",50)),50))," ") & TRIM(RIGHT(SUBSTITUTE(TRIM(A1)," ",REPT(" ",50)),50)) 

我修改和使用如下：

 =SUBSTITUTE(W:W,TRIM(RIGHT(SUBSTITUTE(TRIM(W:W)," ",REPT(" ",100)),100)) & " ","") 

同样在Excel论坛上， 杰拉尔德·希金斯 （ Gerald Higgins）提出了这个问题，我觉得这很有趣，试图破解和解码：

 =SUBSTITUTE(A1," "&RIGHT(A1,LEN(A1)-FIND("ZZZ",SUBSTITUTE(A1," ","ZZZ",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))),"")&" "&RIGHT(A1,LEN(A1)-FIND("ZZZ",SUBSTITUTE(A1," ","ZZZ",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))) 

（但是我已经把我的工作交给了我的经理，所以已经使用了Sid的解决scheme）