Сложнее всего очистить данные, чтобы получить уникальный список имен артистов.
Изучая ваш список, кажется, что если для одной песни указано несколько имен исполнителей, они будут разделены Featuring, & или |
Если это всегда так, вы можете использовать макрос VBA для разделения имен, а затем использовать словарь для сбора списка имен.
Когда вы создаете этот список, тривиально получить также количество раз, когда появляется исполнитель, а также песню с самым высоким рейтингом (это будет песня, связанная с первым экземпляром этого имени).
Мы используем определенный пользователем объект (класс) для хранения информации и собираем эти объекты в словарь, связанный с именем исполнителя.
Обратите внимание, что мы читаем данные листа в массив VBA и выполняем итерацию по массиву. Обычно это выполняется на порядок быстрее, чем итерация по фактическому рабочему листу.
Чтобы получить отчет, мы должны вывести результаты на рабочий лист.
Модуль класса
Option Explicit
'Class module **RENAME**: cArtist
Public Cnt As Long
Public Song As String
Обычный модуль
Option Explicit
Option Compare Text
Sub Artists()
Dim dA As Dictionary, cA As cArtist
Dim vSrc, vRes
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim V, W, X, Y, Z, A, B
Dim I As Long
Dim sKey As String
Set wsSrc = Worksheets("sheet6")
With wsSrc
vSrc = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(columnsize:=2)
End With
Set wsRes = Worksheets("sheet6")
Set rRes = wsRes.Cells(1, 6)
Set dA = New Dictionary
For I = 1 To UBound(vSrc, 1)
W = Split(vSrc(I, 1), "Featuring")
For Each X In W
Y = Split(X, "|")
For Each Z In Y
A = Split(Z, "&")
For Each B In A
sKey = Trim(B)
Set cA = New cArtist
With cA
.Cnt = 1
.Song = Trim(vSrc(I, 2))
End With
If Not dA.Exists(sKey) Then
dA.Add Key:=sKey, Item:=cA
Else
dA(sKey).Cnt = dA(sKey).Cnt + 1
End If
Next B
Next Z
Next X
Next I
ReDim vRes(0 To dA.Count, 1 To 3)
vRes(0, 1) = "Artist Name"
vRes(0, 2) = "Billboard Appearances"
vRes(0, 3) = "Top Song"
I = 0
For Each V In dA.Keys
I = I + 1
With dA(V)
vRes(I, 1) = V
vRes(I, 2) = .Cnt
vRes(I, 3) = .Song
End With
Next V
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
.Sort key1:=rRes(1, 2), order1:=xlDescending, key2:=rRes(1, 1), order2:=xlAscending, MatchCase:=False, Header:=xlYes
.Style = "Output"
With .Columns(2)
.ColumnWidth = .ColumnWidth / 2
.WrapText = True
.HorizontalAlignment = xlCenter
End With
With .Rows(1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
Вывод с учетом вашего ввода выше
