excel公式幫助拆分複雜的名稱

Question

我的任務是進行一些字符串操作，今天一定是我頭腦不好的一天，因爲它比我預期的要困難得多。

我拿第一，第二和第三個名字，從第一和第二和第三列的首字母與任何姓氏

沿着另外，我們需要保持的稱號。

這裏是長名字的一個例子，因爲它現在代表：

先生ÇChrysostomou &先生ÑChrysostomou &太太甲Chrysostomou

太太中號Karseras & MS P Hadjisoteriou &太太ëAthanasiou

Mrs A Theodorou & Mr A Aristotelou & Mrs G Naziri & M Karmiou夫人L Va zanias &太太ģ

佈雷斯韋特&太太海倫西太太大號Vazanias &太太ģ佈雷斯韋特&太太

海倫西太太奧林匹亞Pieridou &太太Ť&先生中號& C先生&太太ķ

米海利德斯JA小姐Santamas & Mrs Santama-Solomonides & Mrs Lida

Santama小姐JA Santamas &夫人MT Santama- Solomonides &夫人利達

Santama先生POLYDOROS Polydorou &女士馬老Themistocleous &太太西爾維婭

Polydorou密斯先生夫人& & Androulla尼古拉斯先生夫人&吉娜Vasso

Demetriou SK Makkofaides女士& Z Koullas先生& Y Koullas女士& Mrs R

Kleopa先生ģZorzy &太太ħLouca Zorzy &小號先生斯達夫羅泊羅斯&太太ý

斯達夫羅泊羅斯太太中號Franceschina & MS分析C Eugeniou &女士OL Toumazides

T /一個三蛋糕先生大衛&太太艾琳尼克松Dhnixon &有限公司 - 辦公室帳戶

，你可以看到，日這可以被認爲是2人甚至3人之間的聯合銀行賬戶。我們必須保持滴度，這可能是先生，女士，小姐，博士，醫生，或先生與第一和第二的名字的首字母和完整姓氏一起，總應小於35人物！

所以，這裏是我一直在後網絡上的一些搜索嘗試：

=IF(LEN(TRIM(E:E))-LEN(SUBSTITUTE(TRIM(E:E)," ",""))>=1,MID(TRIM(E:E),FIND(" ",TRIM(E:E))+1,1),"")& " " &IF(LEN(TRIM(E:E))-LEN(SUBSTITUTE(TRIM(E:E)," ",""))>=2,MID(SUBSTITUTE(TRIM(E:E)," ","",1),FIND(" ",SUBSTITUTE(TRIM(E:E)," ","",1))+1,1),"")

是可以獲得的縮寫，但只有前2

=RIGHT(J:J,LEN(J:J)-FIND(" ",J:J)+1)

得到姓氏，但工作不正常。

我是在想這，或在思考呢？

什麼是我最好的數據的方法呢？

感謝 菲利普

Answer 1

這應該讓你開始。

比方說你的數據看起來像這樣

一個模塊在此代碼粘貼。 （注意：此代碼沒有廣泛的測試，但傳送消息）

Option Explicit 

Sub Sample() 
    Dim MyAr As Variant 
    Dim FinalAr() As String, TmpAr() As String 
    Dim ws As Worksheet 
    Dim lrow As Long, i As Long, n As Long, j As Long 

    '~~> Set this to the relevant sheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     '~~> get last row of col A 
     lrow = .Range("A" & .Rows.Count).End(xlUp).Row 

     '~~> Store the values in an array 
     MyAr = .Range("A1:A" & lrow) 

     '~~> Loop through the array and split it on "&" and store it in another array 
     For i = LBound(MyAr) To UBound(MyAr) 
      If InStr(1, MyAr(i, 1), "&") Then 
       TmpAr = Split(MyAr(i, 1), "&") 

       For j = LBound(TmpAr) To UBound(TmpAr) 
        n = n + 1 
        ReDim Preserve FinalAr(n) 
        FinalAr(n) = Trim(TmpAr(j)) 
       Next j 
      Else 
       n = n + 1 
       ReDim Preserve FinalAr(n) 
       FinalAr(n) = Trim(MyAr(i, 1)) 
      End If 
     Next i 

     '~~> Past the outcome in Col B 
     .Range("B1").Resize(UBound(FinalAr) + 1, 1).Value = Application.Transpose(FinalAr) 

     '~~> Replace all mrs/mr etc 
     .Columns(2).Replace What:="MRS", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

     .Columns(2).Replace What:="MR", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

     .Columns(2).Replace What:="MISS", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

     '~~> Find Last Row of Col B 
     lrow = .Range("B" & .Rows.Count).End(xlUp).Row 

     '~~> Loop through col B and split the names 
     For i = 2 To lrow 
      If InStr(1, .Range("B" & i), " ") Then 
       TmpAr = Split(Trim(.Range("B" & i)), " ") 

       n = 1 

       For j = LBound(TmpAr) To UBound(TmpAr) 
        .Range("B" & i).Offset(, n).Value = TmpAr(j) 
        n = n + 1 
       Next 
      Else 
       .Range("C" & i).Value = .Range("B" & i).Value 
      End If 
     Next i 
    End With 
End Sub 

結果（截圖）