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

Question

我有一个电子表格，其中 A 列是姓名列表。其中一些名字有头衔（例如，John Doe 先生、Jane Doe 小姐、Jane Bloggs 夫人、Cllr Joe Bloggs 等），有些名字没有（只有 Joe Doe、John Bloggs、Jane Doe 等）。我被要求将名字分成三列 - 标题、名字、姓氏。

当我尝试简单的 "text to columns" 时，有标题的地方没问题，但没有标题的地方，名字默认为标题列。

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

Answer 1

如果我必须这样做，那么我使用'Text to columns'。之后我按第三列排序。现在所有只有 2 个值的行都一个接一个地列出。我标记所有这些行的第一列，按 'Ctrl + or' 或单击鼠标右键和 select 'insert cells'。然后系统会询问您是喜欢向下移动还是向右移动。 Select向右移动，一个单元格随心所欲地排列。

Answer 2

您可以使用 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

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

Text to columns - Uniform response with different numbers of Spaces

excel

text-to-column

现场观看：