Страницы: 1
RSS
Сборка листов на один с присвоением даты из названия листа
 
Друзья, приветствую, необходима помощь вот в каком вопросе:
Есть файл (более 100 листов) данные однотипные. Необходимо макросом перенести их на один лист и добавить столбец, который будет содержать дату из названия листа.
Есть один момент:  названия листов имеют названия типа: 15,02 -это означает 15 февраля. Год для всех 2017.

Буду благодарен за любую помощь.
Прикрепляю пример с желаемым результатом и структурой данных
Изменено: Dyroff - 01.12.2017 17:15:26
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
А PowerQuery не подойдет? + там ИТОГО выдано не совсем 646 получается если суммировать. Что там должно быть?
Изменено: Илья Демид - 01.12.2017 17:06:31
 
Илья Демид, Начинать можно с ячейки A4 шапка не нужна.
В идеале VBA чтобы потом я под другую структуру подкорректировать смог. в PowerQuery вообще не знаю ничего
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Сори VBA не смогу быстро сделать, пока вот решение через PQ
На вкладке данные жмем - Создать запрос - Из других источников - пустой запрос. В новом окне влкадка Просмотр расширенный редактор, удалить что там есть и написать. Во 2 строке вставить путь где лежит файл
Код
let
    Источник = Excel.Workbook(File.Contents("СЮДА ВСТАВЬТЕ ПУТЬ К ФАЙЛУ"), null, true),
    #"Удаленные нижние строки" = Table.RemoveLastN(Источник,1),
    #"Удаленные столбцы" = Table.RemoveColumns(#"Удаленные нижние строки",{"Item", "Kind", "Hidden"}),
    #"Добавлен пользовательский объект" = Table.AddColumn(#"Удаленные столбцы", "Пользовательская", each 2017),
    #"Замененное значение" = Table.ReplaceValue(#"Добавлен пользовательский объект",",","-",Replacer.ReplaceText,{"Name"}),
    #"Измененный тип" = Table.TransformColumnTypes(#"Замененное значение",{{"Пользовательская", type text}}),
    #"Добавлен пользовательский объект1" = Table.AddColumn(#"Измененный тип", "Пользовательская.1", each [Name]&"-"&[Пользовательская]),
    #"Измененный тип1" = Table.TransformColumnTypes(#"Добавлен пользовательский объект1",{{"Пользовательская.1", type date}}),
    #"Переименованные столбцы" = Table.RenameColumns(#"Измененный тип1",{{"Пользовательская.1", "Period"}}),
    #"Удаленные столбцы1" = Table.RemoveColumns(#"Переименованные столбцы",{"Name", "Пользовательская"}),
    #"Развернутый элемент Data" = Table.ExpandTableColumn(#"Удаленные столбцы1", "Data", {"Column1", "Column2"}, {"Data.Column1", "Data.Column2"}),
    #"Переименованные столбцы1" = Table.RenameColumns(#"Развернутый элемент Data",{{"Data.Column1", "Index"}, {"Data.Column2", "Name"}}),
    #"Строки с примененным фильтром" = Table.SelectRows(#"Переименованные столбцы1", each ([Index] <> null and [Index] <> " Итого выдано:   " and [Index] <> " не выдано :" and [Index] <> "индексы"))
in
    #"Строки с примененным фильтром"
 
Илья Демид, Спасибо большое, пойду пробовать.)

В режиме ожидания решения на VBA:)
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Цитата
Dyroff написал: Необходимо макросом перенести их на один лист
И что не получается? PLEX пробовали - сборка листов? "Приемы" посетили? Подсказки в "Ссылках" не помогли?..
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Z,  PLEX  не установлен, подсказки в ссылках не помогли, в приемах нет статьи описывающей решение данного вопроса на VBA. Не получается даже близко придумать алгоритм того, как составить полноценную дату из такого названия листа и заставить все это работать.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Цитата
Dyroff написал: Не получается даже близко...
Кому надо - делает, другие же - ищут причины... ;)
См вариант -
Изменено: Z - 01.12.2017 17:48:55
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Z, Я, конечно, благодарен Вам за то, что уделяете время моему вопросу. Но как выглядел весь остальной путь до процедуры поиска и замены? Если Вы просто решили ткнуть меня носом в даты- ок, у Вас получилось.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Много лишнего правда, после заменить "-" на "-" чтобы формат взялся. из примера удалить последний лист
Код
Sub test()
Dim lastrow, lastrows As Long
Dim sN As Worksheet
Dim a As String
    Sheets(1).Activate
    ActiveWorkbook.Sheets.Add
    Sheets(1).Name = "Final"
    Set sN = Sheets("Final")
    For i = 2 To Worksheets.Count
        Sheets(1).Activate
        lastrow = Cells(sN.Rows.Count, 1).End(xlUp).Row + 1
        Sheets(i).Activate
        a = ActiveSheet.Name
        lastrows = Cells(Rows.Count, 1).End(xlUp).Row
        For j = 1 To lastrows
        Cells(j, 3) = a
        Next
        Range(Cells(4, 1), Cells(lastrows, 3)).Copy
        sN.Cells(lastrow, 1).PasteSpecial (xlPasteAll)
    Next
    sN.Activate
    sN.Range("C:C").Replace ",", "-"
    lastrow = Cells(sN.Rows.Count, 3).End(xlUp).Row
    For i = 2 To lastrow
        sN.Cells(i, 3) = Cells(i, 3) & "-2017"
    Next
End Sub
Изменено: Илья Демид - 01.12.2017 17:53:58
 
Илья Демид, То, что надо, спасибо огромное Вам за терпение!

Я вам там в личку вопросик кинул по PQ. Буду благодарен., если ответите)
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Коллеги, в продолжение решение PowerQuery. После только от мусора отфильтровать.
Хм.... Я вот делал запрос прямо в файле примере, на который же в запросе ссылаюсь, а вот не будет ли перебоев при такой работе ?
Код
let
    Source = Excel.Workbook(File.Contents("ПУТЬ К ФАЙЛУ" ), null, true),
    #"Строки с примененным фильтром" = Table.SelectRows(Source, each ([Name] <> "желаемый результат")),
    RemovedOtherColumns = Table.SelectColumns(#"Строки с примененным фильтром",{"Data", "Name","Kind"}),
    OnlySheets = Table.SelectRows(RemovedOtherColumns, each Text.Contains([Kind], "Sheet")),
    Rename = Table.ReplaceValue(OnlySheets, ",","-", Replacer.ReplaceText,{"Name"}),
    AddCol = Table.AddColumn(Rename, "Date",each[Name]&"-2017"),
    DeleteColumns = Table.SelectColumns(AddCol,{"Data","Date"}),
    ColumnsName = Table.ColumnNames(DeleteColumns{0}[Data]),
    ExpandedTable = Table.ExpandTableColumn(DeleteColumns, "Data", ColumnsName)
in
    ExpandedTable
Изменено: Илья Демид - 01.12.2017 18:25:35
 
Проверил свою надстройку
По времени где-то около минуты, что бы сделать настройки.
Результат:
Excel + SQL = Activetables
Страницы: 1
Наверх