Доброго времени суток! Друзья, помогите решить следующую задачу. Имеется рабочий файл "Выборка", в котором имеется рабочий динамичный диапазон в виде столбца А, ссылающийся на столбец J. Наименование в ячейках столбца А дублирует название рабочих файлов книг Ексель, хранящихся в отдельной папке "Рабочая книга". Дело в том, что в папке "Рабочая книга" имеются сотни книг Ексель, а объединение требуют только определенные книги, которые прописаны в столбце А, причем столбец динамичный и в нем наименования в зависимости от условий меняются. Сейчас объединение провожу с помочью макроса (он во вложении для примера), но это крайне не удобно, так как выбирать файлы для объединения приходится вручную. Помогите поправить макрос или предложить свой, чтобы он автоматически объединял нужные файлы из папки "Рабочая книга" в одну книгу. Объединил все файлы в один архив. Заранее благодарю за помощь!
Доброго времени суток! Друзья, помогите решить следующую задачу. Имеется рабочий файл "Выборка", в котором имеется рабочий динамичный диапазон в виде столбца А, ссылающийся на столбец J. Наименование в ячейках столбца А дублирует название рабочих файлов книг Ексель, хранящихся в отдельной папке "Рабочая книга". Дело в том, что в папке "Рабочая книга" имеются сотни книг Ексель, а объединение требуют только определенные книги, которые прописаны в столбце А, причем столбец динамичный и в нем наименования в зависимости от условий меняются. Сейчас объединение провожу с помочью макроса (он во вложении для примера), но это крайне не удобно, так как выбирать файлы для объединения приходится вручную. Помогите поправить макрос или предложить свой, чтобы он автоматически объединял нужные файлы из папки "Рабочая книга" в одну книгу. Объединил все файлы в один архив. Заранее благодарю за помощь!cyraxs
а это специально файлы называются "Книга", но в файле выборки "Кнгига"?
Если опечатка, то вариант PQ:
let
f=(x)=>Excel.CurrentWorkbook(){[Name=x]}[Content],
g=(x)=>[a=Record.Field(dict,x&".xlsx"),
b=Excel.Workbook(a),
c=b{0}[Data]][c],
from = Folder.Files(f("adres"){0}[Column1])[[Name],[Content]],
dict = Record.FromList(from[Content],from[Name]),
lst=List.Select(f("range")[Column1],(x)=>x<>0),
tr=List.Transform(lst,g),
to=Table.Combine(tr)
in
to
а это специально файлы называются "Книга", но в файле выборки "Кнгига"?
Если опечатка, то вариант PQ:
let
f=(x)=>Excel.CurrentWorkbook(){[Name=x]}[Content],
g=(x)=>[a=Record.Field(dict,x&".xlsx"),
b=Excel.Workbook(a),
c=b{0}[Data]][c],
from = Folder.Files(f("adres"){0}[Column1])[[Name],[Content]],
dict = Record.FromList(from[Content],from[Name]),
lst=List.Select(f("range")[Column1],(x)=>x<>0),
tr=List.Transform(lst,g),
to=Table.Combine(tr)
in
to
прохожий2019, тогда у меня ничего не получилось.. При копировании текста макроса, он выделен красным, следовательно не рабочий или я что то делаю не так? (скрин1) При добавлении в ячейку J7 значения нового листа (скрин2), его значение не дублируется в листе "adres" (скрин3), как понимаю должен? Все скрины добавил в архив.
прохожий2019, тогда у меня ничего не получилось.. При копировании текста макроса, он выделен красным, следовательно не рабочий или я что то делаю не так? (скрин1) При добавлении в ячейку J7 значения нового листа (скрин2), его значение не дублируется в листе "adres" (скрин3), как понимаю должен? Все скрины добавил в архив.cyraxs
прохожий2019, Понял о чем Вы. Если цель результата видна в листе "adres", то видимо я не совсем верно обозначил задачу. Необходимо не собрать всю информацию с книг в один лист, а собрать все листы в одну книгу. Так чтобы каждый лист был отдельным. Пример во вложении.
прохожий2019, Понял о чем Вы. Если цель результата видна в листе "adres", то видимо я не совсем верно обозначил задачу. Необходимо не собрать всю информацию с книг в один лист, а собрать все листы в одну книгу. Так чтобы каждый лист был отдельным. Пример во вложении.cyraxs
cyraxs, Здравствуйте. За параметр Имён Книг взял имена из столбца J из вашего файла. Каждый Импортируемый Лист именовал как и сама Книга именова. Думаю вы сами дальше разберётесь. Данный код должен находиться в Книге Выборка, из неё и запускаете данный макрос, в неё и импортируются Листы.
Option Explicit
Sub CombineWorkbooksAutomatically() Dim x AsLong
Application.ScreenUpdating = False
Dim TargetWorkbook As Workbook: Set TargetWorkbook = ThisWorkbook
' "Путь к вашей папке Рабочая книга" Dim SourceFolder AsString: SourceFolder = ThisWorkbook.Path & "\Рабочая книга" & "\"
Dim LastRow AsLong: LastRow = TargetWorkbook.Worksheets(1).Cells(TargetWorkbook.Worksheets(1).Rows.Count, "J").End(xlUp).Row
' Предполагается, что строка заголовков находится в первой строке, поэтому начинаем с 2 For x = 2To LastRow Dim SourceFileName AsString: SourceFileName = TargetWorkbook.Worksheets(1).Cells(x, "J") & ".xlsx" Dim SourceFilePath AsString: SourceFilePath = SourceFolder & "\" & SourceFileName
' Проверяем, существует ли файл в указанной папке IfDir(SourceFilePath) <> ""Then Dim importWB As Workbook: Set importWB = Workbooks.Open(Filename:=SourceFilePath)
' Исключаем расширение ".xlsx" Dim newSheetName AsString: newSheetName = Left(SourceFileName, Len(SourceFileName) - 5)
importWB.Worksheets(1).Copy After:=TargetWorkbook.Worksheets(TargetWorkbook.Sheets.Count)
' Задаем имя листа
TargetWorkbook.Worksheets(TargetWorkbook.Sheets.Count).Name = newSheetName
importWB.Close SaveChanges:=False Else
MsgBox "Файл '" & SourceFileName & "' не найден в папке '" & SourceFolder & "'.", vbExclamation, "Ошибка" EndIf Next x
Application.ScreenUpdating = True
MsgBox "Операция по слиянию Листов Книг из: " & SourceFolder & vbNewLine & "в одну Книгу Выполнено Успешно! " EndSub
Удачи.
cyraxs, Здравствуйте. За параметр Имён Книг взял имена из столбца J из вашего файла. Каждый Импортируемый Лист именовал как и сама Книга именова. Думаю вы сами дальше разберётесь. Данный код должен находиться в Книге Выборка, из неё и запускаете данный макрос, в неё и импортируются Листы.
Option Explicit
Sub CombineWorkbooksAutomatically() Dim x AsLong
Application.ScreenUpdating = False
Dim TargetWorkbook As Workbook: Set TargetWorkbook = ThisWorkbook
' "Путь к вашей папке Рабочая книга" Dim SourceFolder AsString: SourceFolder = ThisWorkbook.Path & "\Рабочая книга" & "\"
Dim LastRow AsLong: LastRow = TargetWorkbook.Worksheets(1).Cells(TargetWorkbook.Worksheets(1).Rows.Count, "J").End(xlUp).Row
' Предполагается, что строка заголовков находится в первой строке, поэтому начинаем с 2 For x = 2To LastRow Dim SourceFileName AsString: SourceFileName = TargetWorkbook.Worksheets(1).Cells(x, "J") & ".xlsx" Dim SourceFilePath AsString: SourceFilePath = SourceFolder & "\" & SourceFileName
' Проверяем, существует ли файл в указанной папке IfDir(SourceFilePath) <> ""Then Dim importWB As Workbook: Set importWB = Workbooks.Open(Filename:=SourceFilePath)
' Исключаем расширение ".xlsx" Dim newSheetName AsString: newSheetName = Left(SourceFileName, Len(SourceFileName) - 5)
importWB.Worksheets(1).Copy After:=TargetWorkbook.Worksheets(TargetWorkbook.Sheets.Count)
' Задаем имя листа
TargetWorkbook.Worksheets(TargetWorkbook.Sheets.Count).Name = newSheetName
importWB.Close SaveChanges:=False Else
MsgBox "Файл '" & SourceFileName & "' не найден в папке '" & SourceFolder & "'.", vbExclamation, "Ошибка" EndIf Next x
Application.ScreenUpdating = True
MsgBox "Операция по слиянию Листов Книг из: " & SourceFolder & vbNewLine & "в одну Книгу Выполнено Успешно! " EndSub
MikeVol, Спасибо большое! То что нужно! Только есть некоторые уточнения: 1. Можно ли сделать так, чтобы листы собирались не в ту книгу где находится макрос, а в новую книгу, чтоб не удалять лишние листы? 2. Если в книге присутствует не один лист, а несколько, то макрос собирает только первый лист, можно это поправить? 3. Макрос собирает только формат xlsx, можно прописать так, чтоб мог собирать и формат xlsm? 4. Верно понял, если изменить путь расположения "Рабочей книги" необходимо прописывать новый путь сюда? ThisWorkbook.Path & "\Рабочая книга" & "\"
MikeVol, Спасибо большое! То что нужно! Только есть некоторые уточнения: 1. Можно ли сделать так, чтобы листы собирались не в ту книгу где находится макрос, а в новую книгу, чтоб не удалять лишние листы? 2. Если в книге присутствует не один лист, а несколько, то макрос собирает только первый лист, можно это поправить? 3. Макрос собирает только формат xlsx, можно прописать так, чтоб мог собирать и формат xlsm? 4. Верно понял, если изменить путь расположения "Рабочей книги" необходимо прописывать новый путь сюда? ThisWorkbook.Path & "\Рабочая книга" & "\"cyraxs
Сообщение отредактировал cyraxs - Четверг, 03.08.2023, 16:26
если изменить путь расположения "Рабочей книги" необходимо прописывать новый путь сюда? ThisWorkbook.Path & "\Рабочая книга" & "\"
Это вы и сами сможете найти в Справке по Excel-ю, ищите ThisWorkbook.Path и много чего ещё найдёте полезной информации. Плохой Учитель из меня получиться. Удачи.
cyraxs, Ловите.
Option Explicit
Sub CombineAllWorkbooksAutomatically() Dim x AsLong Dim ws As Worksheet
Application.ScreenUpdating = False
' Создаем новую книгу Dim NewWorkbook As Workbook: Set NewWorkbook = Workbooks.Add
' "Путь к вашей папке Рабочая книга" Dim SourceFolder AsString: SourceFolder = ThisWorkbook.Path & "\Рабочая книга" & "\"
Dim LastRow AsLong: LastRow = ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, "J").End(xlUp).Row
For x = 2To LastRow
' Включаем все форматы файлов Excel Dim SourceFileName AsString: SourceFileName = ThisWorkbook.Worksheets(1).Cells(x, "J") & ".*" Dim SourceFilePath AsString: SourceFilePath = SourceFolder & "\" & SourceFileName Dim foundFile AsString: foundFile = Dir(SourceFilePath)
DoWhileLen(foundFile) > 0 Dim importWB As Workbook: Set importWB = Workbooks.Open(Filename:=SourceFolder & "\" & foundFile)
For Each ws In importWB.Worksheets
ws.Copy After:=NewWorkbook.Sheets(NewWorkbook.Sheets.Count)
' Исключаем все расширения из имён Книг Dim newSheetName AsString: newSheetName = Left(foundFile, InStrRev(foundFile, ".") - 1)
' Задаем имя листа
NewWorkbook.Sheets(NewWorkbook.Sheets.Count).Name = ws.Name & " " & newSheetName Next ws
importWB.Close SaveChanges:=False
' Поиск следующего файла с тем же именем, но другим расширением
foundFile = Dir Loop
если изменить путь расположения "Рабочей книги" необходимо прописывать новый путь сюда? ThisWorkbook.Path & "\Рабочая книга" & "\"
Это вы и сами сможете найти в Справке по Excel-ю, ищите ThisWorkbook.Path и много чего ещё найдёте полезной информации. Плохой Учитель из меня получиться. Удачи.MikeVol
Ученик. Одесса - Украина
Сообщение отредактировал MikeVol - Четверг, 03.08.2023, 17:59
MikeVol, Доброго времени суток! Появилась новая проблема при работе с макросом. Имя файла ограничено следующими критериями: длиной имени и отсутствием возможности добавлять символы в имени (скрин во вложении). Можно это исправить?
MikeVol, Доброго времени суток! Появилась новая проблема при работе с макросом. Имя файла ограничено следующими критериями: длиной имени и отсутствием возможности добавлять символы в имени (скрин во вложении). Можно это исправить?cyraxs
Нет конечно, код вам сам говорит что нельзя! Вся информации у вас в сообщение ошибки. Соблюдайте Избегайте всё то что у вас выведено в сообщение ошибки и не будет у вас проблем с работой кода. Удачи.
Нет конечно, код вам сам говорит что нельзя! Вся информации у вас в сообщение ошибки. Соблюдайте Избегайте всё то что у вас выведено в сообщение ошибки и не будет у вас проблем с работой кода. Удачи.MikeVol
Ученик. Одесса - Украина
Сообщение отредактировал MikeVol - Вторник, 08.08.2023, 12:22