|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
23.02.2010, 11:33 | #1 |
Пользователь
Регистрация: 09.02.2010
Сообщений: 41
|
Макрос импорта Ексель файлов из папки в листы одной книги с последующим выполнения макросов.СПБ.
Сбор макросом рабочих листов из внешних Excel файлов с последующим выполнением другого макроса-научите, пожалуйста. Использую прекрасный макрос с форума,-спасибо Форуму-Учителю. Макрос умеет открывать много файлов в одну книгу-подшивку; рабочие листы при этом именуются по имени файлов.
Подскажите, пожалуйста, есть ли макрос который бы ВЫПОЛНЯЛСЯ при открытии-вставке, импорте файлов в листы. То есть, что нужно добавить в пропись макроса, чтобы, например, пустые строки в импортируемых файлах удалялись сразу же или в момент вставки файла-таблицы. Все внешние файлы состоять из одной, хотя и большой, таблицы, в которой встречаются пустые элементы или строки. Отдельно такой макрос для удаления я использую (приведён в конце), но приходится вручную. ----------------------------------------------------- Sub CombineWorkbooks() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "Не выбрано ни одного файла!" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets(ThisWork book.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub ----------------------------------------------------- ИЛИ,- Необходимо сделать так, чтобы файлы открывались в листы-заготовки той книги, из которой собственно они сейчас и вызываются, и открываются, А НЕ СОЗДАВАЛИ бы новые рабочие листы, как это происходит сейчас. Возможно подсказка в следующем макросе (снова спасибо форумчанам). Данный макрос вставляет два файла (таблицы). А как сделать, чтобы вставлялись таблицы из всех Ексель файлов, которые в папке или был вариант выбора файлов из списка. Последнее как раз и реализовано в макросе, который выше. Никак не могу скрестить эти два макроса. ----------------------------------------------------- Sub Main() Dim i As Integer Application.ScreenUpdating = False Const myPath = "C:\TEMP" 'Подставьте требуемый путь к папке. For i = 1 To 2 With ThisWorkbook.Sheets(i) Workbooks.Open Filename:=myPath & Application.PathSeparator & i & ".xls" Cells.Copy .[A1] ActiveWorkbook.Close SaveChanges = False End With Next End Sub ----------------------------------------------------- Например, я создаю основную книгу с десятью рабочими листами - пустыми, но с макросами или функциями в тех ячейках, которые не будут заняты импортированными данными. После этого использую приведённый макрос и открываю 10 внешних Ексель файлов. **В идеале число листов основного файла-книги на лету создаётся и зависит от того, сколько выбрано файлов для импорта. Чем вызвана проблема, - я не смог найти макрос, который бы исполнялся сразу для всех рабочих листов. ("Выполнение макроса во всех листах" - форум ещё за 2008, - виноват, ничего не понял). Таким образом попробую обойти проблему, зашивая макросы в рабочие листы-заготовки. И если внешние файлы (они все стандартны) будут в них открываться, простите за наивность, то макросы и будут исполняться. Буду очень признателен за решение. Рад заочному знакомству с профессионалами. Файлы не присоединяю - вся моя проблема в приведённых макросах. Спасибо огромное. *** Макрос удаления, который использую я, - удаляет строки с нулевым элементом в колонке ----------------------------------------------------- Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r).Columns( 9)) = 0 Then Rows(r).Delete Next r End Sub ----------------------------------------------------- |
23.02.2010, 12:39 | #2 |
Регистрация: 23.02.2010
Сообщений: 5
|
Вот макрос который собирает несколько файлов Excel в 1 лист.
Врать не буду, писал не сам, дёрнул на каком-то форуме (может и на этом). Автору ещё раз большое спасибо. Макрос дорабатывал под себя, дополнительное форматирование и т.д. (то что тебе нужно) вставляешь после строки ".StatusBar = False" Удачи! Sub Макрос1() Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат Const blInsertNames = True 'вставлять строку заголовка (книга, лист) перед содержимым листа Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _ i As Integer, stbar As Boolean, clTarget As Range On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию ChDir strStartDir On Error GoTo 0 With Application 'меньше писанины arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True) If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла Set wbTarget = Workbooks.Add(template:=xlWorksheet ) Set shTarget = wbTarget.Sheets(1) .ScreenUpdating = False stbar = .DisplayStatusBar .DisplayStatusBar = True For i = 1 To UBound(arFiles) .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles) Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True) For Each shSrc In wbSrc.Worksheets If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой Set clTarget = shTarget.Range("A1").Offset(shTarge t.Range("A1").SpecialCells(xlCellTy peLastCell).Row, 0) If blInsertNames Then clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name Set clTarget = clTarget.Offset(1, 0) End If shSrc.UsedRange.Copy clTarget End If Next wbSrc.Close False 'закрыть без запроса на сохранение Next .ScreenUpdating = True .DisplayStatusBar = stbar .StatusBar = False On Error Resume Next 'если указанный путь не существует и его не удается создать, 'обзор начнется с последней использованной папки If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir ChDir strSaveDir On Error GoTo 0 arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу") If VarType(arFiles) = vbBoolean Then 'если не выбрано имя GoTo save_err Else On Error GoTo save_err wbTarget.SaveAs arFiles End If End save_err: MsgBox "Книга не сохранена!", vbCritical End With ' ' Макрос1 Макрос ' Макрос записан 28.01.2010 (Admin) ' ' Сочетание клавиш: Ctrl+z ' End Sub |
23.02.2010, 13:19 | #3 | |
Форумчанин
Регистрация: 13.01.2010
Сообщений: 410
|
Цитата:
для обработки всех листов в книге используйте код типа Код:
|
|
23.02.2010, 20:07 | #4 |
Пользователь
Регистрация: 09.02.2010
Сообщений: 41
|
Выдает, к сожалению, ошибку в строке
Set clTarget = shTarget.Range("A1").Offset(shTarge t.Range("A1").SpecialCells(xlCellTy peLastCell).Row, 0) Завтра буду пробовать разобрать код. Спасибо. |
23.02.2010, 20:13 | #5 |
Форумчанин
Регистрация: 13.01.2010
Сообщений: 410
|
пробелы лишние не видите? или это так и надо?
|
24.02.2010, 09:09 | #6 |
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
Вы не указали, все листы выбранных книг нужно копировать или нет. Сколько их, и как при этом называть создаваемые листы.
Пусть, например, все открываемые книги имеют 1 лист. Тогда скопировать их в одну книгу, присвоить имя согласно имени файла и удалить пустые строки можно так: Код:
Чем шире угол зрения, тем он тупее.
|
24.02.2010, 09:36 | #7 |
Пользователь
Регистрация: 09.02.2010
Сообщений: 41
|
1.Выбранные книги содержат только по одному листу.
2.Приведённый код делает в принципе тоже, что и было. Но выскакивает ошибка при некорректном представлении имени открываемого файла, что не принципиально. 3. Ещё одна очень важная деталь - я удаляю не только пустые строки, но и строки в которых есть хотя бы одна пустая ячейка (макрос такого действия был приведён ранее - еще раз его вставлю ниже) ---------------------------------------------------------------------- Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r).Columns( 9)) = 0 Then Rows(r).Delete Next r End Sub ---------------------------------------------------------------------- Возможно моя ошибка, - требуется, чтобы открываемые книги (файлы) копировались в уже существующие листы книги, из которой они вызываются (открываются). То есть проблема не в том, как подшить файлы в одной книге и дать листам имена файлов. Проблема - вставить файлы в уже существующие листы, в которых имеются макросы обработки вставляемого. Может это слишком заумно, но проблема выросла из задачи, - как выполнить макрос одновременно для всех листов книги. Я уже научился открывать файлы в листы (меня спасает то, что все вставляемые книги содержат по одному листу); нашел макрос для обработки каждого листа. Но бьюсь на автоматизацией обработки всех рабочих листов. Спасибо |
24.02.2010, 09:58 | #8 |
Пользователь
Регистрация: 09.02.2010
Сообщений: 41
|
""""пробелы лишние не видите? или это так и надо?"""""
Увидел, потому что уже утро, Спасибо. Но SpecialCells(xlCellTy peLastCell) ""peLastCell"" ещё не увидел, потому что утро и ещё не вечер. Спасибо, учусь. |
24.02.2010, 09:59 | #9 |
Старожил
Регистрация: 05.12.2007
Сообщений: 4,180
|
А зачем иметь кучу листов, да еще и с кучей макросов? Не проще ли иметь один макрос, который запускается по событию книги Workbook_NewSheet(ByVal Sh As Object). Т.е. при каждом добавлении нового листа.
Чем шире угол зрения, тем он тупее.
|
24.02.2010, 10:01 | #10 |
Пользователь
Регистрация: 09.02.2010
Сообщений: 41
|
SpecialCells(xlCellTypeLastCell), - Все просто. И ещё раз спасибо.
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Макрос постоянно обрабатывает события. При открытии другой книги макрос обрывается. | Ples | Microsoft Office Excel | 8 | 17.12.2016 18:15 |
Измение гиперссылок на листы книги при переименовании файла | Aswerd | Microsoft Office Excel | 0 | 18.02.2010 01:26 |
excel+vba странности взаимодействия при сохранении книги без макросов | alvazor | Microsoft Office Excel | 7 | 06.07.2009 17:22 |
Выбор файлов для импорта. | Sorro | Microsoft Office Excel | 8 | 06.05.2009 12:16 |
При закрытии книги, удаляются листы | Romuald | Microsoft Office Excel | 3 | 20.01.2009 21:34 |