excel公式有助於拆分復雜名稱

Question

我被要求進行一些字符串操作，今天一定是我頭疼的日子，因為事實證明這比我預期的要困難得多。

我必須從第一，第二和第三列中提取第一，第二和第三名稱的縮寫以及所有姓氏

另外，我們需要保留標題。

這是現在的長名稱示例：

C Crysostomou先生和N N Chrysostomou先生及A Chrysostomou夫人

M Karseras女士＆P Hadjisoteriou女士＆E Athanasiou女士

西奧多魯夫人（Ms A Theodorou）和亞里士多德（Aristotelou）夫人，納茲里（G Naziri）夫人和卡米歐（Karmiou）M女士

Braithwaite和太太Helen West太太L Vazanias和太太G Braithwaite和太太

海倫·韋斯特（Helen West）女士奧林匹亞·皮里杜（Olympia Pieridou）女士和T＆mr女士M和C先生＆K女士

Michaelides小姐JA Santamas女士和MT Santama女士-Solomonides女士和Lida女士

桑塔瑪JA Santamas小姐和MT桑塔瑪夫人-Solomonides＆Lida夫人

Santama Mr Polydoros Polydorou和Maro Themistocleous夫人＆Sylvia夫人

Polydorou先生Themis和Androulla夫人＆Nicholas先生＆Vasso Gina夫人

Demetriou SK Makkofaides夫人，Z Koullas夫人，Y Koullas夫人和R夫人

Kleopa先生G Zorzy女士和H Louca Zorzy女士＆S Stavropoulos先生＆Y女士

Stavropoulos女士Franceschina女士＆C Eugeniou女士＆OL Toumazides女士

T / a戴維先生和艾琳·尼克松夫人（Dhnixon＆Co.）三杯蛋糕-辦公室帳戶

如您所見，這些可以被視為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

OutCome（屏幕截圖）