Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Разделение ячейки по разделителю на строки, с созданием новых строк.
 
#1
13.05.2024 08:37:33
Есть таблица в которой в одном столбце идет информация кооторую нужно разделить на несколько строк по разделителю,при этом в этих строках не должно быть никакой информации кроме той,что находилась в ячейке. Я не совсем представляю как это можно сделать. По этому был бы признателен, если бы мне помогли разобраться в этом! Так эе приложен пример в файле.
 
 
 
#2
13.05.2024 08:45:49
можно в Power Query кнопками натыкать:
Код
let
    Источник = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Измененный тип" = Table.TransformColumnTypes(Источник,{{"Регион", type text}, {"Орг", type text}, {"Дата", type datetime}, {"Разрешение", Int64.Type}, {"Номер", Int64.Type}, {"Column6", type text}}),
    #"Разделить столбец по разделителю" = Table.ExpandListColumn(Table.TransformColumns(#"Измененный тип", {{"Column6", Splitter.SplitTextByDelimiter("; ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Column6"),
    #"Измененный тип1" = Table.TransformColumnTypes(#"Разделить столбец по разделителю",{{"Column6", type text}})
in
    #"Измененный тип1"
 
 
 
#3
13.05.2024 09:20:17
Код
Sub mySplit()
    Dim ru As Range
    On Error Resume Next
    Set ru = Intersect(Selection, ActiveSheet.UsedRange)
    On Error GoTo 0
    If Not ru Is Nothing Then SplitRange ru
End Sub

Private Sub SplitRange(rr As Range)
    Dim Application_Calculation As XlCalculation
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    
    Dim cl As Range
    For Each cl In rr.Cells
        SplitCell cl
    Next

    Application.Calculation = Application_Calculation
End Sub

Private Sub SplitCell(cl As Range)
    Dim arr As Variant
    arr = GetSplitArray(cl.Value)
    If Not IsEmpty(arr) Then
        If UBound(arr, 1) > 0 Then
            cl.Cells(2, 1).EntireRow.Resize(UBound(arr, 1) - 1).Insert
            cl.Resize(UBound(arr, 1)).Value = arr
        End If
    End If
End Sub

Private Function GetSplitArray(ss As String) As Variant
    ss = myTrim(ss, ";")
    If ss <> "" Then
        Dim arr As Variant
        arr = Split(ss, ";")
        If UBound(arr) > LBound(arr) Then
            Dim brr As Variant
            ReDim brr(1 To UBound(arr) + 1, 1 To 1)
            Dim ya As Long
            For ya = LBound(arr) To UBound(arr)
                brr(ya + 1, 1) = arr(ya)
            Next
            GetSplitArray = brr
        End If
    End If
End Function

Private Function myTrim(ByVal ss As String, CH As String) As String
    Do
        If ss = "" Then Exit Do
        If Right(ss, 1) = CH Then
            ss = Left(ss, Len(ss) - Len(CH))
        Else
            Exit Do
        End If
    Loop
    myTrim = ss
End Function
Выделите ячейки Column6, запустите макрос mySplit.
 
 
 
#4
13.05.2024 09:42:05
nilske, К сожалению, это разделит столбец на несколько стообцов, но не строк без заполнения
 
 
 
#5
13.05.2024 09:49:44
МатросНаЗебре, Спасибо огромное, все сработало!
 
 
 
#6
13.05.2024 09:52:57
ThorOff, что значит "разделит" - то, что Вы не попробовали, а предполагаете?
в любом случае жаль, что для самостоятельного старта этот вариант Вам не подошёл
 
 
 
#7
13.05.2024 09:54:06
Вы пробовали макрос от МатросНаЗебре, ?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
13.05.2024 10:00:30
Sanja, Да, на неболшой таблице работает все верно, сейчас пробую применить ко всем даным.
 
 
 
#9
13.05.2024 12:50:07
Цитата
ThorOff написал:
это разделит столбец на несколько стообцов
напраслину не возводите
Цитата
ThorOff написал:
но не строк без заполнения
а как же столбец с датами?
консервы
Пришелец-прораб.
 
 
 
#10
14.05.2024 07:04:15
AlienSx, на счет столбца с датами прошу прощения, ошибочно заполнен. Спасибо большое, что указали на это!
 
 
 
#11
14.05.2024 07:20:14
nilske, Прощу прощения, что не ответил, но я попробовал, у меня делит на столбцы. Может я что-то не то сделал, можете объяснить подробнее?
 
 
 
#12
14.05.2024 09:16:09
ThorOff, там при делении в опциях нужно найти пункт "на строки"
а вообще, хорошее решение предложил AlienSx в #9 (открываете расширенный редактор и вставляете этот код).
 
 
 
#13
14.05.2024 09:46:51
nilske, Код действительно работает, уже проверил, конечно много времени займет, но ничего страшного. Для себя хотел уточнить, все-таки долго искал решение в квери самостоятельно, и не сог найти его, а сейчас попробовал и да работает, заполняет другие столбцы, но работает)
 
 
 
#14
14.05.2024 10:30:55
ThorOff, вам конечный результат важен или принципиально, чтобы другие столбцы оставались пустыми сразу?
если конечный результат, то вот вам все кнопками:
Код
let    Источник = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Измененный тип" = Table.TransformColumnTypes(Источник,{{"Регион", type text}, {"Орг", type text}, {"Дата", type datetime}, {"Разрешение", Int64.Type}, {"Номер", Int64.Type}, {"Column6", type text}}),
    #"Разделить столбец по разделителю" = Table.ExpandListColumn(Table.TransformColumns(#"Измененный тип", {{"Column6", Splitter.SplitTextByDelimiter(";", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Column6"),
    #"Сгруппированные строки" = Table.Group(#"Разделить столбец по разделителю", {"Орг"}, {{"Количество", each _, type table [Регион=nullable text, Орг=nullable text, Дата=nullable datetime, Разрешение=nullable number, Номер=nullable number, Column6=nullable text]}}),
    #"Добавлен пользовательский объект" = Table.AddColumn(#"Сгруппированные строки", "Пользовательский", each Table.AddIndexColumn([Количество], "Индекс", 1, 1, Int64.Type)),
    #"Удаленные столбцы" = Table.RemoveColumns(#"Добавлен пользовательский объект",{"Количество"}),
    #"Развернутый элемент Пользовательский" = Table.ExpandTableColumn(#"Удаленные столбцы", "Пользовательский", {"Регион", "Дата", "Разрешение", "Номер", "Column6", "Индекс"}, {"Регион", "Дата", "Разрешение", "Номер", "Column6", "Индекс"}),
    #"Добавлен пользовательский объект1" = Table.AddColumn(#"Развернутый элемент Пользовательский", "Орг2", each if [Индекс] = 1 then [Орг] else ""),
    #"Добавлен пользовательский объект2" = Table.AddColumn(#"Добавлен пользовательский объект1", "Регион2", each if [Индекс] = 1 then [Регион] else ""),
    #"Добавлен пользовательский объект3" = Table.AddColumn(#"Добавлен пользовательский объект2", "Дата2", each if [Индекс] = 1 then [Дата] else ""),
    #"Добавлен пользовательский объект4" = Table.AddColumn(#"Добавлен пользовательский объект3", "Разрешение2", each if [Индекс] = 1 then [Разрешение] else ""),
    #"Добавлен пользовательский объект5" = Table.AddColumn(#"Добавлен пользовательский объект4", "Номер2", each if [Индекс] = 1 then [Номер] else ""),
    #"Другие удаленные столбцы" = Table.SelectColumns(#"Добавлен пользовательский объект5",{"Column6", "Орг2", "Регион2", "Дата2", "Разрешение2", "Номер2"}),
    #"Переупорядоченные столбцы" = Table.ReorderColumns(#"Другие удаленные столбцы",{"Орг2", "Регион2", "Дата2", "Разрешение2", "Номер2", "Column6"})
in
    #"Переупорядоченные столбцы"
Изменено: voler83 - 14.05.2024 10:32:00
 
 
 
#15
14.05.2024 12:52:45
voler83, Здравствуйте, не понимаю этот шаг, как вы его осуществили?
Цитата
написал:
#"Сгруппированные строки" = Table.Group(#"Разделить столбец по разделителю", {"Орг"}, {{"Количество", each _, type table [Регион=nullable text, Орг=nullable text, Дата=nullable datetime, Разрешение=nullable number, Номер=nullable number, Column6=nullable text]}}),
 
 
 
#16
14.05.2024 13:33:34
ThorOff, группировка стандартной кнопкой - выбрать параметр группировки без агрегации (вычислений) - "Все строки" - тогда просто вся таблица "делится на куски" (в данном случае по каждой организации) и сворачивается как вложенные таблицы-куски исходной таблицы. Нажмите на шестеренку справа от шага "Сгруппированные строки".
Изменено: voler83 - 14.05.2024 13:35:17
 
 
 
#17
14.05.2024 14:03:45
Разбить текст в ячейке по строкам через произвольный разделитель
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх