Как разбить ячейку текста и перенести ее в столбец и снова разбить?

Question

Я искал много постов, форумов, учебных пособий, пытался объединить некоторые из них, но у меня ничего не получалось. Теперь я пишу некоторый код, который по логике c Я учусь на других языках программирования, он должен работать, но я пропускаю несколько шагов.

Давайте предположим, что у меня есть строка, подобная этой Test User <TUser@my-domain.pl>; Test User2 <TUser2@my-domain.pl>; Test User3 <TUser3@my-domain.pl>; Test User4 <TUser4@my-domain.pl>;

Я вставляю это в ячейку, скажем, A1. Моя цель - остаться с тестовым пользователем или TUser для каждой строки поменьше.

Я могу достичь своей цели, сделав так:

1. Нажмите Текст в столбцах -> С разделителями -> Другие ;, теперь каждая строка находится в отдельном столбце
2. Копировать всю строку и вставьте ее с помощью транспонирования (поворота), чтобы каждая строка была в отдельной строке
3. Теперь самый простой способ - использовать текст в виде столбцов - по разделителю <. Так что все, что мне осталось, это Name Surname в одной ячейке, а остальные в другой

Я хочу добиться этого, нажав на кнопку, конечно.

Мой код так далеко:

Sub GetName()

Dim WordList As String
Dim ArrayOfWords
Dim i, i2 As Integer

'Define my word list, based on cell
WordList = Cells(1, 1)

'Use SPLIT function to convert the string to an array
ArrayOfWords = Split(WordList, "<")

'Iterate through array, and put each string into new row cell
i = 2
i2 = 1
Do While (ThereIsNoMoreText)'That I cannot figure out

Cells(2, i).Value = ArrayOfWords(i2)

i = i + 1
i2 = i2 + 1

Loop

End Sub

Спасибо за помощь заранее, и я надеюсь, что проясню:)

Answer 1

Забавная маленькая альтернатива:

Sub Test()

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(?:<.*?>)"
    arr = Split(.Replace([A1], ""), ";")
End With

With Cells(1, 2).Resize(UBound(arr))
    .Value = Application.Transpose(arr)
    .Value = Application.Trim(.Value)
End With

End Sub

Очевидно, обязательно создайте явную ссылку на лист для Cells.

Answer 2

Сначала вам нужно разделить точку с запятой.

Разбейте следующее на части, чтобы получить нужные вам строки:

userlist = Split(Cells(1, 1).Value, ";")
i = 1
For Each user In userlist
    i = i + 1
    splituser = Split(user, "<")
    Cells(i, 1) = splituser(0)
    Cells(i, 2) = Mid(splituser(1), 1, Len(splituser(1)) - 1)
Next

Answer 3

В дополнение к методам, показанным в других ответах (в частности, очень впечатляющим от @JvdV), вы также можете попробовать это.

Этот метод не использует For… Далее

Sub Users_Email_Split()
Dim aData As Variant
    With ThisWorkbook.Worksheets("TEST")
        aData = .Cells(1).Value
        aData = Left(aData, -2 + Len(aData))
        aData = Replace(aData, " <", """,""")
        aData = Replace(aData, ">; ", """;""")
        aData = "{""" & aData & """}"
        aData = Application.Evaluate(aData)
        .Cells(2, 2).Resize(UBound(aData), UBound(aData, 2)).Value = aData
    End With
    End Sub

РЕДАКТИРОВАТЬ
Если ожидается, что string превысит ограничение в 255 символов для функции оценки, то вы можете использовать этот метод (максимум до 2086 символов) .

Этот метод a создает User Defined Name со строкой массива в качестве формулы, затем применяет имя в качестве FormulaArray и, наконец, устанавливает значение диапазона.

Sub Users_Email_Split_Plus255()
Dim aData As Variant
Dim lR As Long, lC As Long

    With ThisWorkbook.Worksheets("TEST")

        aData = .Cells(11, 1).Value
        aData = Left(aData, -2 + Len(aData))
        aData = Replace(aData, " <", """,""")
        aData = Replace(aData, ">; ", """;""")
        aData = "={""" & aData & """}"

        lR = 1 + UBound(Split(aData, ";"))
        lC = 1 + UBound(Split(Split(aData, ";")(0), ","))

        With .Cells(12, 2).Resize(lR, lC)

            .Worksheet.Names.Add Name:="_FmlX", RefersTo:=aData
            .FormulaArray = "=_FmlX"
            .Value = .Value

    End With: End With

    End Sub

Answer 4

Вы должны немного изменить конструкцию

Dim i As Long
Dim FirstPart As String, SecondPart As String
Dim ArrayOfWords
ArrayOfWords = Split(Cells(1, 1).Value, ";")
For i = LBound(ArrayOfWords) To UBound(ArrayOfWords)
    If InStr(1, ArrayOfWords(i), "<") > 0 Then
        FirstPart = Left(ArrayOfWords(i), InStr(1, ArrayOfWords(i), "<") - 1)
        SecondPart = Mid(ArrayOfWords(i), Len(FirstPart) + 1, Len(ArrayOfWords(i)))
        Debug.Print FirstPart & "--" & SecondPart
    End If
Next i