Вы можете сделать это довольно просто с помощью Power Query aka Get & Transform, который доступен в Excel с 2010 года. Для более ранних версий VBA была бы хорошей альтернативой.
Все операции, кроме создания двух пользовательских столбцов, могут быть выполнены из пользовательского интерфейса. Пользовательские столбцы требуют ввода формул в диалоговом окне создания пользовательских столбцов.
В Power Query:
- Добавьте пользовательский столбец для удаления части
@domain из электронного письма. Назовите столбец CharName
Text.Start([Character],Text.PositionOf([Character],"@"))
- Удалить оригинальную
Characters колонку
- Группировка по
CharName
- Добавить пользовательский столбец, который преобразует результирующий
Table в список
Table.Column([Count],"ID")
В результирующем столбце IDs выберите двойную стрелку в правом верхнем углу столбца и выберите Extract Values с разделителем запятых
Разделите этот столбец по разделителю (запятая), и будут созданы новые столбцы
Удалить оригинальную Table колонку
- Транспонировать весь стол
- Повышение содержания первого ряда до заголовков
Вот М-код:
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Character", type text}, {"ID", Int64.Type}}),
#"Added Custom" = Table.AddColumn(#"Changed Type", "CharName", each Text.Start([Character],Text.PositionOf([Character],"@"))),
#"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"Character"}),
#"Grouped Rows" = Table.Group(#"Removed Columns", {"CharName"}, {{"Count", each _, type table [ID=number, CharName=text]}}),
#"Added Custom1" = Table.AddColumn(#"Grouped Rows", "IDs", each Table.Column([Count],"ID")),
#"Extracted Values" = Table.TransformColumns(#"Added Custom1", {"IDs", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
#"Split Column by Delimiter" = Table.SplitColumn(#"Extracted Values", "IDs", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"IDs.1", "IDs.2", "IDs.3"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"IDs.1", Int64.Type}, {"IDs.2", Int64.Type}, {"IDs.3", Int64.Type}}),
#"Removed Columns1" = Table.RemoveColumns(#"Changed Type1",{"Count"}),
#"Transposed Table" = Table.Transpose(#"Removed Columns1"),
#"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
#"Changed Type2" = Table.TransformColumnTypes(#"Promoted Headers",{{"Yoda", Int64.Type}, {"Luke", Int64.Type}, {"Anakin", Int64.Type}, {"Jabba", Int64.Type}})
in
#"Changed Type2"
И вот окончательный результат, исходя из ваших исходных данных:
Если вы предпочитаете метод VBA, вы можете создать словарь наборов идентификаторов для каждого символа. Вам нужно будет разобраться в приведенном ниже коде, чтобы понять его, и адаптировать его к вашей конкретной книге и настройке рабочего листа.
Option Explicit
'Set reference to Microsoft Scripting Runtime
Sub charIDs()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim D As Dictionary, COL As Collection, sKey As String
Dim I As Long, J As Long
Dim V As Variant
Set wsSrc = Worksheets("Source")
Set wsRes = Worksheets("Results")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End With
Set D = New Dictionary
D.CompareMode = TextCompare
'Create a dictionary of collections of Id's for each character
For I = 2 To UBound(vSrc, 1)
sKey = Split(vSrc(I, 1), "@")(0)
If Not D.Exists(sKey) Then
Set COL = New Collection
COL.Add vSrc(I, 2)
D.Add Key:=sKey, Item:=COL
Else
D(sKey).Add vSrc(I, 2)
End If
Next I
'create results array
I = 0
For Each V In D.Keys
I = IIf(I > D(V).Count, I, D(V).Count)
Next V
ReDim vRes(0 To I, 1 To D.Count)
'Populate
J = 0
For Each V In D.Keys
J = J + 1
vRes(0, J) = V
For I = 1 To D(V).Count
vRes(I, J) = D(V)(I)
Next I
Next V
'size and fill results range
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