Текст в столбцы - равномерный ответ с разным количеством пробелов

Question

У меня есть электронная таблица, где столбец A - это список имен.У некоторых из этих имен есть названия (например, «Мистер Джон Доу», «Мисс Джейн Доу», «Миссис Джейн Блоггс», «Джо Блоггс» и т. Д.), Некоторые из названий не имеют названия (только «Джо Доу», «Джон Блоггс», «Джейн Доу» и т. Д.).Меня попросили разделить имена на три столбца - Название, Имя, Фамилия.

Когда я пробую простой текст в столбцы, хорошо, когда есть заголовок, а где нет.'t one, имя по умолчанию соответствует столбцу заголовка.

Есть ли способ разбить данные на правильные ячейки, или это будет большая ручная работа для кого-то?

Answer 1

Для этого вы можете использовать VBA.

Вы создадите два разных массива.Первый - это ваши необработанные данные (ваш единственный столбец) preArr() и ваш новый массив, который будет записан обратно на лист postArr(), который был рассчитан на три столбца ReDim postArr(..., 1 To 3).

Во-первых,проверить, содержит ли строка из preArr(i, 1) известные приветствия.Если это так, то вы добавите первую разделенную строку к postArr(, 1) - иначе вы ничего не добавите к этому столбцу.

Примечание : вы можете добавить дополнительныеприветствия этой строке:

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

Это регулярное выражение, но просто добавьте еще один разделитель | для дополнительных проверок.Я объединил MR и MRS в одну группу, ? делает S необязательным, если вам интересно.

Вот полная программа:

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

---

Посмотреть вживую:

Answer 2

Если мне нужно сделать это, я использую «Текст в столбцы».После этого я сортирую по третьему столбцу.Теперь все строки, имеющие только 2 значения, перечислены один за другим.Я отмечаю первый столбец для всех этих строк, нажимаю «Ctrl + или» или щелкаю правой кнопкой мыши и выбираю «вставить ячейки».Затем вас спросят, хотите ли вы сместиться вниз или вправо.Выберите сдвиг вправо, и ячейки будут расположены так, как вам нравится.