Как перебрать ячейки?

Question

[kentos]

Всем привет, как можно реализовать перебор ячеек?

Есть ячейка:

"Характеристики изделия|Вид карманов|Втачные и накладные 
Состав|Состав|75% хлопок, 20% полиэстер, 5% эластан   
Характеристики изделия|Назначение|Одежда повседневная, спорт
Характеристики изделия|Вид застежки|Застежка «молния»
Характеристики изделия|Посадка|Средняя
Характеристики изделия|Крой|Свободный
Цвет изделия|Цвет изделия|Черный, синий, серый
Характеристики изделия|Фактура материала|Трикотаж"

Мне нужно придумать, как реализовать скрипт, подкиньте идею, а отсортировать нужно по типу
Название(например:сjстав) Измерение(например:%) и Значение(например 100% хлопок)

Вот как я разбивал руками:

Answer 1

[Пычев Анатолий]

Разбейте и запишите по разным ячейкам в одну строку или в несколько, зависит то количества типов характеристик (Вид карманов, Назначение, Вид застежки и т.д)

Но это можно сделать только макросом

Если все в одну строку, тогда думаю вопросов не возникает, а если в разные, то
колонки получаться такие - "Состав", "Цвет", Тип характеристики", Значение характеристики"

Comments

[kentos]

ну вот я разбивал руками, как это можно автоматизировать, даже теми макросами

[Пычев Анатолий]

ну вот как-то так

spoiler

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

Файл с прогой

[kentos]

Пычев Анатолий, А можно как-нибудь сделать так, чтобы в одну строку записывалочь?

[Пычев Анатолий]

kentos, конечно.
перепишите функцию PrintParams
Она отвечает за вывод

[kentos]

Пычев Анатолий, я без понятия, как обозначить в строчку(