Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Разнести данные из ячейки по разделителю
 
Доброго времени суток, Уважаемые друзья!
Есть вопрос на который не могу найти ответ и опять иду к вам.

У меня есть данные на одном листе, в одной из ячеек есть данные через разделитель "/". Пример:
Китай/Россия/Франция
Как можно размножить все данные ниже по листу через vba, чтобы было по одному значению из перечисленного?

Заранее всем благодарен!
 
в PQ можно кнопками
Код
let
    Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    #"Разделить столбец по разделителю" = Table.ExpandListColumn(Table.TransformColumns(Источник, {{"Страна прозводства", Splitter.SplitTextByDelimiter("/", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Страна прозводства"),
    #"Измененный тип" = Table.TransformColumnTypes(#"Разделить столбец по разделителю",{{"Страна прозводства", type text}}),
    #"Сортированные строки" = Table.Sort(#"Измененный тип",{{"Страна прозводства", Order.Ascending}})
in
    #"Сортированные строки"
 
Макросом
 
msi2102, спасибо огромное, помогите немного поправить. Делится все, а это не требуется, только один столбец с разделителем который "/", остальные данные без изменений должны остаться, как в примере и на одном лите остаться (но без исходного, то есть как вы сделали). Пытался сейчас сам поправить, не могу сообразить. Заранее очень сильно благодарен, если не поможете все равно огромное спасибо!
Пример.PNG (41.1 КБ)
 
Код
Option Explicit

Sub tt()
    Dim a, i&, x&, y&, el, elel, col As New Collection

    a = [a1].CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1    'текстовое сравнение
        On Error Resume Next
        For i = 2 To UBound(a)
            For Each el In Split(a(i, 6), "/")
                col.Add el, el
                If Not .exists(el) Then .Add el, New Collection
                .Item(el).Add i
            Next
        Next
        On Error GoTo 0

        y = 1    'тут пишем номер первой строки результата!

        For Each el In col
            ReDim b(1 To UBound(a), 1 To UBound(a, 2))
            For x = 1 To UBound(a, 2)
                b(1, x) = a(1, x)
            Next
            i = 1
            For Each elel In .Item(el)
                i = i + 1
                For x = 1 To UBound(a, 2)
                    b(i, x) = a(elel, x)
                Next
                b(i, 6) = el
            Next

            Cells(y, 1).Resize(i, UBound(b, 2)) = b
            y = y + i + 1
        Next

    End With

End Sub


Можете пробовать выполнить при
Россия/Китай/Франция
Россия/Франция
Россия/Китай
Изменено: Hugo - 12 авг 2020 18:49:33
 
Hugo, спасибо!
Страницы: 1
Читают тему (гостей: 1)
Наверх