Sub Zamena()
Dim i As Long
Dim iLastRow As Long
Dim n As Long
Dim FirstWord As String
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
If InStr(1, Cells(i, "A"), ",") > 0 Then
FirstWord = Split(Split(Cells(i, "A"), ",")(0), " ")(0)
n = Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), ",", "")) 'кол-во запятых
Rows(i + 1).Insert
Cells(i + 1, "A") = Split(Cells(i, "A"), ",")(0)
Do
Rows(i + 1).Insert
Cells(i + 1, "A") = FirstWord & " " & Split(Cells(i, "A"), ",")(n)
n = n - 1
Loop While n > 0
Range(Cells(i, "B"), Cells(i + Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), ",", "")) + 1, "B")).FillDown
Rows(i).Delete
End If
Next
End Sub
let
from = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
split1 = Table.SplitColumn(from, "Столбец1", Splitter.SplitTextByEachDelimiter({" "}), {"Позиция", "Цвет"}),
split2 = Table.ExpandListColumn(Table.TransformColumns(split1, {"Цвет", Splitter.SplitTextByDelimiter(", ")}), "Цвет"),
to = Table.AddColumn(split2, "Имя", each if [Цвет]<>null then [Позиция]&" "&[Цвет] else [Позиция] )[[Имя],[Столбец2]]
in
to
Андрей VG спасибо вам) Kuzmich ваш вариант классный, а если задача посложнее то как ее решить?
К примеру --- Note 7 4/64 Black,Blue --- И можно пожалуйста побольше комментариев, что бы на вашем примере было проще разобраться как вы это реализовали)
БМВ не уверен что верно понял вопрос. Думаю что можно основное название разделить знаком от перечисления цвета, к примеру _ --- Samsung Galaxy S10+ 1 ТБ_черная керамика, белая керамика --- Samsung Galaxy S10+ 1 ТБ черная керамика Samsung Galaxy S10+ 1 ТБ белая керамика --- Прикреплю новый вариант Спасибо БМВ за верное замечание
DartoArem, поняли верно, и это относится только многословным описаниям цвета. Все упостится в разы, если разделителем будет все таже запиятая Samsung Galaxy S10+ 1 ТБ,_черная керамика, белая керамика Nokia, Black, Blue, Red Note 7 4/64,Black,Blue
Kuzmich все работает отлично Хотелось бы вас побеспокоить еще один раз, как добавить присваивание значения и из третей колонки? Не только цена но и версия товара.
а вот насчет черная и белая керамика пока затрудняюсь ответить
я это решил методом костыля Перед выполнением вашего макроса, написал макрос в котором убрал пробелы у таких цветов как белая керамика, черная керамика, space black а потом в конце вернул им пробелы.
можно основное название разделить знаком от перечисления цвета, к примеру _ --- Samsung Galaxy S10+ 1 ТБ_черная керамика, белая керамика
Код
Sub Zamena()
Dim i As Long
Dim iLastRow As Long
Dim n As Long
Dim FirstWord As String
Dim SecondWord As String
Dim arr
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
If InStr(1, Cells(i, "A"), ",") > 0 Then 'более одного цвета
FirstWord = Split(Cells(i, "A"), "_", 2)(0)
SecondWord = Split(Cells(i, "A"), "_", 2)(1)
arr = Split(SecondWord, ",") 'цвета в массив
For n = UBound(arr) To 0 Step -1 'цикл по цветам
Rows(i + 1).Insert
Cells(i + 1, "A") = FirstWord & " " & arr(n)
Next
Range(Cells(i, "B"), Cells(i + UBound(arr) + 1, "C")).FillDown
Rows(i).Delete
Else
If InStr(1, Cells(i, "A"), "_") > 0 Then
Cells(i, "A") = Replace(Cells(i, "A"), "_", " ")
End If
End If
Next
End Sub