excel - 文本到列 - 具有不同空格数的统一响应

Question

我有一个电子表格，其中 A 列是名称列表。其中一些名字有标题(例如，Mr John Doe、Miss Jane Doe、Mrs Jane Bloggs、Cllr Joe Bloggs 等)有些名字没有(只有 Joe Doe、John Bloggs、Jane Doe 等)。我被要求将名字分成三列 - 标题、名字、姓氏。

当我尝试简单的“文本到列”时，有标题的地方很好，但没有标题的地方，名字默认为标题列。

有没有办法将数据拆分到正确的单元格中，或者对某人来说是否需要大量的手动工作？

Answer 1

您可以使用 VBA 来完成此操作。
您将创建两个不同的数组。第一个是您的原始数据(您的单列)preArr() , 以及将写回工作表 postArr() 的新数组已针对三列进行尺寸标注ReDim postArr(..., 1 To 3) .
首先，测试是否来自 preArr(i, 1) 的字符串包含已知的称呼。如果是，则将第一个拆分字符串添加到 postArr(, 1) - 否则您不会在此列中添加任何内容。

Side Note: You can add additional salutations to this line:

.Pattern = "^(?:MRS?|MS|MIS+|CLLR|DR)\.?\s"

This is a regular expression, but just add another | separator for additional checks. I combined MR and MRS into one group, the ? makes the S optional in case you were wondering.

这是完整的程序:

Option Explicit

Sub splitOnNames()

    Dim preArr(), postArr(), ws As Worksheet, preRng As Range
    Set ws = Selection.Parent
    Set preRng = Selection
    
    preArr = preRng.Value
    If UBound(preArr, 2) > 1 Then
        MsgBox "This can only be done on a single column!", vbCritical
        Exit Sub
    End If
    ReDim postArr(LBound(preArr) To UBound(preArr), 1 To 3)
    
    Dim i As Long, x As Long, tmpArr
    For i = LBound(preArr) To UBound(preArr)
        If preArr(i, 1) <> "" Then
            tmpArr = Split(preArr(i, 1))
            If testSalutation(preArr(i, 1)) Then
                postArr(i, 1) = tmpArr(0)
                postArr(i, 2) = tmpArr(1)
                For x = 2 To UBound(tmpArr) 'Some last names have two names
                    postArr(i, 3) = Trim(postArr(i, 3) & " " & tmpArr(x))
                Next x
            Else
                postArr(i, 2) = tmpArr(0)
                For x = 1 To UBound(tmpArr) 'Some last names have two names
                    postArr(i, 3) = Trim(postArr(i, 3) & " " & tmpArr(x))
                Next x
            End If
            Erase tmpArr
        End If
    Next i
    
    With preRng
        Dim postRng As Range
        Set postRng = ws.Range(ws.Cells(.Row, .Column), _
                ws.Cells(.Rows.Count + .Row - 1, .Column + 2))
        postRng.Value = postArr
    End With

End Sub

Private Function testSalutation(ByVal testStr As String) As Boolean

    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Pattern = "^(?:MRS?|MS|MIS+|CLLR|DR)\.?\s"
        testSalutation = .Test(testStr)
    End With
    
End Function

现场观看: