公式，如果一個姓單元和輸出的簡化串

Question

我有幾千個項目，其中包括若干不同的名字連在一起，像這樣的列表中重複：

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 K U 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 

有時姓氏重複在細胞內，有時它不是。

我想建立一個公式來確定姓氏是否重複，並返回一個字符串，其中Salutations/titles和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 

仍將作爲姓氏是不同的相同

是否有可能做用公式（而不是使用文本到列來分割名稱），我該怎麼做？

感謝 菲利普

Answer 1

我相信巴里和洛瑞會拿出一個聰明的公式:)不過這裏是一個VBA例子可能只是解決你的老闆的breathing問題;）

粘貼在此代碼一個模塊。 （僅與以下屏幕截圖中的示例進行了測試）。我冒昧地操縱一個單元格值來考慮多個姓氏的匹配。見細胞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這個優秀的公式使用阿拉丁Akyurekhere它計算多少空格在單元格中（用來決定是否需要首字母縮寫，就好像沒有Salutaion或名字，只使用姓氏一樣）

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

在Ozgrid Forums金東想出了這個正則表達式解決方案，它讓我又更多的鼓勵來打我奧賴利正則表達式食譜再次：

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 forumsSNB上來用這個可愛列陣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 forumsmdmackillop想出了巧妙的思維這個可愛位：

=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)) & " ","") 

也Mr Excel Forums傑拉爾德·希金斯提出這個我發現相當有趣的嘗試打破和解碼：

=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的解決方案）