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

Question

Я пытаюсь разделить ячейки Excel на основе заголовка. Но не удалось. Есть ли какие-либо VBA или формулы для разделения или разделения на несколько столбцов?

Я хочу разделить, как показано ниже системы:

Основной текст | Заголовок 2 | Заголовок 3 | Заголовок 4 | Заголовок 5

Я попытался разделить ячейку по разделам. Но не удалось. Я использовал Kutools Excell Addon. Но не работает. Снимок экрана прилагается.

Lorem Ipsum Dolor Sit Amet, Concetetur Adipiscing Elit. Donec placerat mollis urna, quis aliquam orci luctus ne c.

== Заголовок 2: Сюжет ==

Sed rutrum luctus lorem. Совершено c nibh mi, laoreet vel lectus a, viverra egestas diam. Vestibulum eget tortor est. Mauris magna enim, laoreet a efficitur et, scelerisque ne c felis.

=== Заголовок 3: Cast ===

Nulla ne c Commodo Tellus. Aliquam Sed Diam Sollicitudin, Tempor Ex ID, Dignissim Sem. Morbi mauris augue, congue id blandit in, rutrum quis sapien.

==== Заголовок 4: Обзор ====

Ut commodo tellus ut lectus convallis pretium. Монахиня c Элит Масса, Дигниссим Нон Орчи и др., Транспортная сила. Etiam euismod arcu sed quam faucibus mattis. Nam maximus velit et eleifend dapibus.

===== Заголовок 5: Ссылки =====

Proin porttitor quis turpis a c fermentum. Suspendisse Eget Urna Arcu. Pellentesque viverra enim Velit, et mollis enim eleifend non. Pellentesque eget dapibus dolor. Etiam vitae neque ut nun c egestas rutrum.

Answer 1

Попробуйте,

Sub Test()
    Dim Ws As Worksheet
    Dim s As String
    Dim pattn As String
    'Dim Match As MatchCollection
    Dim Match  As Object
    Dim vR() As Variant
    Dim i As Long, n As Long, k As Long
    Dim vSplit As Variant

    s = Range("a1")
    pattn = "(Heading[ ]{1,}\d{1,}[ :\w]{1,})"

    Set Match = GetRegEx(s, pattn)

    s = ReplaceRegEx(s, pattn, "mysplit")
    s = Replace(s, "=", "")
    vSplit = Split(s, " mysplit")
    n = UBound(vSplit)
    ReDim vR(1 To (n + 1) * 2 - 1)
    k = 1
    For i = 0 To n - 1
        vR(k) = vSplit(i)
        vR(k + 1) = Match.Item(i)
        k = k + 2
    Next i
    vR(UBound(vR)) = vSplit(n)
    Range("c1").Resize(1, UBound(vR)) = vR '<~~ content and Heading
    Range("c2").Resize(1, n + 1) = vSplit '<~~  contents
End Sub
Function GetRegEx(StrInput As String, strPattern As String) As Object
    Dim RegEx As Object

    'Set RegEx = New RegExp
    Set RegEx = CreateObject("VBscript.RegExp")
    With RegEx
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = strPattern
    End With
    If RegEx.Test(StrInput) Then
        Set GetRegEx = RegEx.Execute(StrInput)
       'GetRegEx = RegEx.Replace(StrInput, strReplace)
    End If
End Function

Function ReplaceRegEx(StrInput As String, strPattern As String, strReplace)
    Dim RegEx As Object

    'Set RegEx = New RegExp
    Set RegEx = CreateObject("VBscript.RegExp")
    With RegEx
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = strPattern
    End With
    If RegEx.Test(StrInput) Then
       ReplaceRegEx = RegEx.Replace(StrInput, strReplace)
    End If
End Function

Изображение результата