Вы можете использовать макрос, написанный на VBA.
Я создал класс и переименовал его в cData со свойствами различных заголовков столбцов.
Затем я использовал регулярные выражения для разделенияотличать свойства от предоставленных вами данных, собрать их в словарь и вывести результаты на отдельную таблицу в указанном порядке.
Я предположил, что заголовки именованных столбцов - это информация, которую вы ищете, и,как в вашем текстовом примере, есть только один экземпляр каждой категории, к которому нужно обратиться.
Я также предположил, что ваши данные начинаются с B1.
Внимательно прочитайте примечания вмакрос.
Обязательно установите ссылки, как указано в коде обычного модуля.
Модуль класса
'Rename this Module **cData**
Option Explicit
Private pCorrelationID As String
Private pRequestForApi As String
Private pCaller As String
Private pRequestedSchemas As String
Private pTenantID As String
Public Property Get CorrelationID() As String
CorrelationID = pCorrelationID
End Property
Public Property Let CorrelationID(Value As String)
pCorrelationID = Value
End Property
Public Property Get RequestForApi() As String
RequestForApi = pRequestForApi
End Property
Public Property Let RequestForApi(Value As String)
pRequestForApi = Value
End Property
Public Property Get Caller() As String
Caller = pCaller
End Property
Public Property Let Caller(Value As String)
pCaller = Value
End Property
Public Property Get RequestedSchemas() As String
RequestedSchemas = pRequestedSchemas
End Property
Public Property Let RequestedSchemas(Value As String)
pRequestedSchemas = Value
End Property
Public Property Get TenantID() As String
TenantID = pTenantID
End Property
Public Property Let TenantID(Value As String)
pTenantID = Value
End Property
Обычный модуль
'Set Reference to Microsoft Scripting Runtime
'Set Reference to Microsoft VBScript Regular Expressions 5.5
Option Explicit
Sub ttcSpecial()
Dim wsSrc As Worksheet, wsRes As Worksheet
Dim vSrc As Variant, vRes As Variant
Dim rRes As Range
Dim dD As Dictionary
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim cD As cData
Dim myKey, I As Long, sTemp As String
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
vSrc = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
If Not IsArray(vSrc) Then
sTemp = vSrc
ReDim vSrc(1 To 1, 1 To 1)
vSrc(1, 1) = sTemp
End If
End With
Set RE = New RegExp
With RE
.Global = True
.IgnoreCase = True
.MultiLine = False
.Pattern = "((?:CorrelationID|Request For API|Caller|RequestedSchemas|TenantID)):([\s\S]+?)(?=(?:CorrelationID|Request For API|Caller|RequestedSchemas|TenantID|$))"
End With
Set dD = New Dictionary
dD.CompareMode = TextCompare
For I = 1 To UBound(vSrc, 1)
Set cD = New cData
With cD
If RE.Test(vSrc(I, 1)) = True Then
myKey = I
Set MC = RE.Execute(vSrc(I, 1))
For Each M In MC
Select Case M.SubMatches(0)
Case "CorrelationID"
.CorrelationID = M.SubMatches(1)
Case "Request for API"
.RequestForApi = M.SubMatches(1)
Case "Caller"
.Caller = M.SubMatches(1)
Case "RequestedSchemas"
.RequestedSchemas = M.SubMatches(1)
Case "TenantID"
.TenantID = M.SubMatches(1)
End Select
Next M
dD.Add Key:=myKey, Item:=cD
End If
End With
Next I
ReDim vRes(0 To dD.Count, 1 To 5)
'Headers
vRes(0, 1) = "Correlation ID"
vRes(0, 2) = "Request for API"
vRes(0, 3) = "Caller"
vRes(0, 4) = "Requested Schemas"
vRes(0, 5) = "Tenant ID"
I = 0
For Each myKey In dD.Keys
I = I + 1
With dD(myKey)
vRes(I, 1) = .CorrelationID
vRes(I, 2) = .RequestForApi
vRes(I, 3) = .Caller
vRes(I, 4) = .RequestedSchemas
vRes(I, 5) = .TenantID
End With
Next myKey
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
Результаты из образца текста в исходном вопросе
Regex упрощенное объяснение
- Соответствует любому из заголовков столбцов
- Соответствует всему, что начинается после двоеточия
- до, но НЕ включая другой заголовок столбца или конецстрока