2

我有一个包含数千个项目的列表，其中包含几个不同的名称，如下所示：

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

有时姓氏在单元格内重复，有时则不重复。

我想建立一个公式来确定姓氏是否重复，并返回一个字符串，其中称呼/标题和首字母在末尾与姓氏连接，除非姓氏不同。

例如，

- 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

将保持相同，因为姓氏不同

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

谢谢菲利普

4

2 回答 2

3

我相信 Barry 或 Lori 会想出一个聪明的公式 :) 但是这里有一个 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

截屏

在此处输入图像描述

于 2013-05-02T09:52:22.317 回答
0

在过去一周的这项任务中，我发现 Excel MVP Aladin Akyurek先生 在这里使用了这个出色的公式，它计算了一个单元格中有多少个空格（用它来决定是否需要首字母，好像没有 Salutaion 或名字，只有姓氏用来）

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

在Ozgrid 论坛上， Jindon提出了这个正则表达式解决方案，它给了我更多的鼓励，让我再次点击我的 O'Reilly正则表达式食谱：

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

于 2013-05-03T08:47:49.047 回答