Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Модель и несколько цветов в одной ячейке. Разнести по строкам.
 
#1
30.09.2019 17:26:04
Здравствуйте, форумчане.
Помогите разобраться.

Как сделать в VBA при поиски в столбце значения записать результат в несколько ячеек.

Nokia Black, Blue, Red
---
Nokia Black
Nokia Blue
Nokia Red

Прикрепляю пример, слева что есть справа что должно стать
Изменено: DartoArem - 30.09.2019 18:16:28
 
 
 
#2
30.09.2019 19:28:57
Доброе время суток.
Пока VBA-ашники ужинают, вариант на Power Query.
 
 
 
#3
30.09.2019 19:35:03
Уже поужинал, мой вариант
Код
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
Замена в тех же столбцах
 
 
 
#4
30.09.2019 19:39:37
Код
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
Изменено: buchlotnik - 30.09.2019 19:43:37
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#5
30.09.2019 19:47:54
Андрей VG спасибо вам)
Kuzmich ваш вариант классный, а если задача посложнее то как ее решить?

К примеру
---
Note 7 4/64 Black,Blue
---
И можно пожалуйста побольше комментариев, что бы на вашем примере было проще разобраться как вы это реализовали)
 
 
 
#6
30.09.2019 20:14:36
DartoArem, необходимо ввести понятие что есть цвет.
Что будете делать с Samsung Galaxy S10+ 1 ТБ, черная керамика, белая керамика?
По вопросам из тем форума, личку не читаю.
 
 
 
#7
30.09.2019 20:29:41
Замените строку
Код
        FirstWord = Split(Split(Cells(i, "A"), ",")(0), " ")(0)
на
Код
       FirstWord = Left(Split(Cells(i, "A"), ",")(0), InStrRev(Split(Cells(i, "A"), ",")(0), " ") - 1)
 
 
 
#8
30.09.2019 20:30:45
БМВ не уверен что верно понял вопрос.
Думаю что можно основное название разделить знаком от перечисления цвета, к примеру _
---
Samsung Galaxy S10+ 1 ТБ_черная керамика, белая керамика
---
Samsung Galaxy S10+ 1 ТБ черная керамика
Samsung Galaxy S10+ 1 ТБ белая керамика
---
Прикреплю новый вариант
Спасибо БМВ за верное замечание
 
 
 
#9
30.09.2019 20:34:15
DartoArem, поняли верно, и это относится только многословным описаниям цвета. Все упостится в разы, если разделителем будет все таже запиятая
Samsung Galaxy S10+ 1 ТБ,_черная керамика, белая керамика
Nokia, Black, Blue, Red
Note 7 4/64,Black,Blue
По вопросам из тем форума, личку не читаю.
 
 
 
#10
30.09.2019 20:45:02
Kuzmich все работает отлично
Хотелось бы вас побеспокоить еще один раз, как добавить присваивание значения и из третей колонки?
Не только цена но и версия товара.
 
 
 
#11
30.09.2019 20:57:50
Цитата
как добавить присваивание значения и из третей колонки?
Надо добавить еще одну строку
Код
        Range(Cells(i, "B"), Cells(i + Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), ",", "")) + 1, "B")).FillDown
        Range(Cells(i, "C"), Cells(i + Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), ",", "")) + 1, "C")).FillDown 'добавленная строка
а вот насчет черная и белая керамика пока затрудняюсь ответить
 
 
 
#12
30.09.2019 21:02:10
Kuzmich спасибо вам большое)
 
 
 
#13
30.09.2019 21:10:34
Цитата
а вот насчет черная и белая керамика пока затрудняюсь ответить
я это решил методом костыля
Перед выполнением вашего макроса, написал макрос в котором убрал пробелы у таких цветов как белая керамика, черная керамика, space black
а потом в конце вернул им пробелы.
 
 
 
#14
30.09.2019 21:54:30
Если
Цитата
можно основное название разделить знаком от перечисления цвета, к примеру _
---
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
Изменено: Kuzmich - 01.10.2019 10:14:37 (Видоизменил код)
 
 
 
Страницы: 1
Наверх