Необходимо по особенному распарсить таблицу. Что только не пробовал (разделитель по запятым в том числе). Это необходимо для дальнейшей работы в PowerBI. Массив данных очень большой, просто руками не сделать
Буду очень благодарен за идеи!
Необходимо по особенному распарсить таблицу. Что только не пробовал (разделитель по запятым в том числе). Это необходимо для дальнейшей работы в PowerBI. Массив данных очень большой, просто руками не сделать
Sub test() Dim lr&, data, i&, j&, temp, r& [d1].CurrentRegion.Offset(1).ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row data = Range("a2:b" & lr).Value r = 2 For i = 1 To UBound(data) temp = Split(data(i, 2), ",") For j = 0 To UBound(temp) Cells(r, "d") = data(i, 1) Cells(r, "e") = temp(j) r = r + 1 Next j Next i End Sub
[/vba]
AngelOfLegend, вариант макросом: [vba]
Код
Sub test() Dim lr&, data, i&, j&, temp, r& [d1].CurrentRegion.Offset(1).ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row data = Range("a2:b" & lr).Value r = 2 For i = 1 To UBound(data) temp = Split(data(i, 2), ",") For j = 0 To UBound(temp) Cells(r, "d") = data(i, 1) Cells(r, "e") = temp(j) r = r + 1 Next j Next i End Sub
For i = 2 To UBound(arr1) lr = shRes.UsedRange.Row + shRes.UsedRange.Rows.Count arr2 = Split(arr1(i, 2), ",") With shRes.Rows(lr).Resize(UBound(arr2) + 1) .Columns("A").Value = arr1(i, 1) .Columns("B").Value = WorksheetFunction.Transpose(arr2) End With Next
Application.ScreenUpdating = True
End Sub
[/vba]
Вариант с макросом. После работы макроса будет создан новый лист. [vba]
Код
Sub Парсинг()
Dim shSrc As Worksheet, shRes As Worksheet, arr1(), arr2 Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set shSrc = ActiveSheet Set shRes = Worksheets.Add(After:=shSrc)
For i = 2 To UBound(arr1) lr = shRes.UsedRange.Row + shRes.UsedRange.Rows.Count arr2 = Split(arr1(i, 2), ",") With shRes.Rows(lr).Resize(UBound(arr2) + 1) .Columns("A").Value = arr1(i, 1) .Columns("B").Value = WorksheetFunction.Transpose(arr2) End With Next
AngelOfLegend, вопросы по своей теме задавайте здесь, не нужно в личку писать.
Для того, чтобы перенести макрос в другой файл, нажмите alt+f11 (или вкладка Разработчик-Visual Basic) - Вы в редакторе VBA. В модуле module1 есть макрос test. Его нужно скопировать в модуль рабочего файла. Для этого откройте редактор VBA рабочего файла - щелкните правой кнопкой мыши (пкм) по VB-проекту книги (см. скрин) нажмите insert-module - 2-м щелчком откройте созданный модуль - вставьте код макроса.
Или вариант попроще: модуль с макросом (все там же, в редакторе VBA) можно перетащить мышкой из одного VB-проекта в другой.
Чтобы привязать макрос к кнопке, щелкаете пкм по кнопке-назначить макрос-выбираете test (ну или как Вы его там назовете).
[p.s.]И вариант Karataevа посмотрите, он тоже старался![/p.s.]
AngelOfLegend, вопросы по своей теме задавайте здесь, не нужно в личку писать.
Для того, чтобы перенести макрос в другой файл, нажмите alt+f11 (или вкладка Разработчик-Visual Basic) - Вы в редакторе VBA. В модуле module1 есть макрос test. Его нужно скопировать в модуль рабочего файла. Для этого откройте редактор VBA рабочего файла - щелкните правой кнопкой мыши (пкм) по VB-проекту книги (см. скрин) нажмите insert-module - 2-м щелчком откройте созданный модуль - вставьте код макроса.
Или вариант попроще: модуль с макросом (все там же, в редакторе VBA) можно перетащить мышкой из одного VB-проекта в другой.
Чтобы привязать макрос к кнопке, щелкаете пкм по кнопке-назначить макрос-выбираете test (ну или как Вы его там назовете).
[p.s.]И вариант Karataevа посмотрите, он тоже старался![/p.s.]Manyasha
О Боги, Вы не представляете как мне помогаете! Да, я вариант Karataevа тоже себе сразу скопировал ( что бы не потерять). Я уже начал изучать работу с макросами) Спасибо и за эту помощь. Не могу уже сидеть на работе (часов 13 просидел). Буду пробовать переносить в понедельник. Как я могу Вас отблагодарить(очень-очень хочу) ?
О Боги, Вы не представляете как мне помогаете! Да, я вариант Karataevа тоже себе сразу скопировал ( что бы не потерять). Я уже начал изучать работу с макросами) Спасибо и за эту помощь. Не могу уже сидеть на работе (часов 13 просидел). Буду пробовать переносить в понедельник. Как я могу Вас отблагодарить(очень-очень хочу) ?AngelOfLegend
для разнообразия, UDF в Power Query SplitAndExpand [vba]
Код
(Таблица as table,НомСтолб as number, Разделитель as text) as table => let Столбец = List.Range(Table.ColumnNames(Таблица),НомСтолб,1){0}, fn = Splitter.SplitTextByDelimiter(Разделитель, QuoteStyle.None), Разделить = Table.TransformColumns(Таблица,{Столбец, fn}), Результат = Table.ExpandListColumn(Разделить,Столбец) in Результат
[/vba] Использование в запросе [vba]
Код
let Источник = SplitAndExpand(Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],1,",") in Источник
[/vba]
для разнообразия, UDF в Power Query SplitAndExpand [vba]
Код
(Таблица as table,НомСтолб as number, Разделитель as text) as table => let Столбец = List.Range(Table.ColumnNames(Таблица),НомСтолб,1){0}, fn = Splitter.SplitTextByDelimiter(Разделитель, QuoteStyle.None), Разделить = Table.TransformColumns(Таблица,{Столбец, fn}), Результат = Table.ExpandListColumn(Разделить,Столбец) in Результат
[/vba] Использование в запросе [vba]
Код
let Источник = SplitAndExpand(Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],1,",") in Источник
В общем, когда я начал подставлять все варианты в рабочий afqk, начались проблемы? ничего и никаким вариантом (макрос, формула, Query) =( Не учел что бывают пустые колонки, и пробелы между словами в одной из характеристик. =(
В общем, когда я начал подставлять все варианты в рабочий afqk, начались проблемы? ничего и никаким вариантом (макрос, формула, Query) =( Не учел что бывают пустые колонки, и пробелы между словами в одной из характеристик. =(AngelOfLegend
AngelOfLegend, а что должно быть там, где пустые ячейки? С пробелами тоже не поняла, нарисуйте в файле, какой должен быть результат для Вашего примера.
AngelOfLegend, а что должно быть там, где пустые ячейки? С пробелами тоже не поняла, нарисуйте в файле, какой должен быть результат для Вашего примера.Manyasha
AngelOfLegend, добавьте условие для пустой характеристики: [vba]
Код
Sub test() Dim lr&, data, i&, j&, temp, r& [d1].CurrentRegion.Offset(1).ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row data = Range("a2:b" & lr).Value r = 2 For i = 1 To UBound(data) If data(i, 2) = "" Then Cells(r, "d") = data(i, 1) r = r + 1 Else temp = Split(data(i, 2), ",") For j = 0 To UBound(temp) Cells(r, "d") = data(i, 1) Cells(r, "e") = temp(j) r = r + 1 Next j End If Next i End Sub
[/vba]
AngelOfLegend, добавьте условие для пустой характеристики: [vba]
Код
Sub test() Dim lr&, data, i&, j&, temp, r& [d1].CurrentRegion.Offset(1).ClearContents lr = Cells(Rows.Count, 1).End(xlUp).Row data = Range("a2:b" & lr).Value r = 2 For i = 1 To UBound(data) If data(i, 2) = "" Then Cells(r, "d") = data(i, 1) r = r + 1 Else temp = Split(data(i, 2), ",") For j = 0 To UBound(temp) Cells(r, "d") = data(i, 1) Cells(r, "e") = temp(j) r = r + 1 Next j End If Next i End Sub
AngelOfLegend, ну дык если в ваш последний файл перенести UDF и запрос из файла отсюда и отформатировать исходные данные умной таблицей с заголовками (у нее должно быть название Таблица1), то на выходе получится именно такой результат
AngelOfLegend, ну дык если в ваш последний файл перенести UDF и запрос из файла отсюда и отформатировать исходные данные умной таблицей с заголовками (у нее должно быть название Таблица1), то на выходе получится именно такой результатkrosav4ig
Всем привет! Нужна помощь в разборе файла с адресами Необходимо в разные столбцы разнести отдельные элементы адреса: город,улица,дом. Например. Есть первая ячейка, это некий ID и ячейка D-адрес
Всем привет! Нужна помощь в разборе файла с адресами Необходимо в разные столбцы разнести отдельные элементы адреса: город,улица,дом. Например. Есть первая ячейка, это некий ID и ячейка D-адресAbriss