Public Sub StartParse()
Dim lLastRow As Long
Dim cell As Range
Dim s As String
Dim v, vp As Variant
Dim i As Long
Dim j As Long
' Определяем последнюю строку данных в столбце 2
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
If lLastRow = 1 Then
' нет данных, выход
Exit Sub
End If
' пробегаем в цигле во всем ячейкам столбца 2
For Each cell In Range("B2:B" & lLastRow)
'Разбиваем данные на характеристки по символу переноса строк
v = Split(cell.Text, vbLf)
For i = LBound(v) To UBound(v)
' Обрабатываем только не пустые элементы
If Len(v(i)) > 0 Then
' Заполняем таблицу
Call PrintParams(Code:=Cells(cell.Row, 1), Param:=v(i))
End If
Next i
Next cell
Sheets("Лист2").Activate
End Sub
Private Sub PrintParams(ByVal Code As String, ByVal Param As String)
Dim lLastRow As Long
Dim v, vp As Variant
Dim i As Long
' не останавливаемся на ошибках
On Error Resume Next
' работаем с листом "Лист2"
With Sheets("Лист2")
' Определяем сдедующую пустую строку данных в столбце 2
lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
'Разбиваем характеристку по символу |
v = Split(Param, "|")
' Первый элемент это тип характеристики, пропускаем
' Второй - название
' третий значение
' Разбиваем значение по символу ","
vp = Split(v(2), ",")
For i = LBound(vp) To UBound(vp)
.Cells(lLastRow, 1) = Trim$(Code)
.Cells(lLastRow, 2) = Trim$(v(1))
.Cells(lLastRow, 3) = Trim$(vp(i))
lLastRow = lLastRow + 1
Next i
End With
End SubАПИ Вайбера не предусматривает возможности просмотра сообщений в группах.
перепишите функцию PrintParams
Она отвечает за вывод