|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
11.11.2010, 09:39 | #1 |
Регистрация: 11.11.2010
Сообщений: 6
|
Объединение листов с предварительным редактированием
Требуется помощь знающих людей. Сам я в программировании не силен в VBA в особенности, но требуется достаточно быстро написать макрос. Задача в том чтобы преобразовать документ excel(отчеты с разных регионов, все в одном документе каждый регион на отдельном листе) к виду пригодному для экспорта на сайт(текстовый документ с заданными разделителями). Для того чтобы объединить листы, воспользовался следующим не безызвестным макросом:
Sub Kusp() Const strStartDir = "d:\" 'папка, с которой начать обзор файлов Const strSaveDir = "d:\" 'папка, в которую будет предложено сохранить результат Const blInsertNames = False 'вставлять строку заголовка (книга, лист) перед содержимым листа Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _ i As Integer, stbar As Boolean, clTarget As Range Dim Cnt As Integer 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 End Sub Столкнулся со следующими проблемами: 1) До обработки книги данным макросом книга нуждается в редактировании(убрать первый лист, удалить заголовок), не подскажите в какую часть данного кода можно подставить необходимые строки? 2) Как можно сосчитать количество заполненных строк в документе?количество листов? 3) Как применить преобразование ко всем листам книги(к примеру удаление первых 2ух строк) 4) Как преобразовать полученную книгу в текстовый документ |
11.11.2010, 09:45 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Слишком много вопросов)
И не факт, что ответы на них помогут вам написать работающий макрос. Будет проще написать макрос "с нуля" - под ваши требования. Прикрепите к сообщению: 1) папку с 2-3 файлами, которые требуется обработать (выделив в них зелёным цветом все ячейки (на всех листах), которые должны попасть в результат) 2) текстовый файл - пример того, что должно получиться на выходе (хватит 2-10 заполненных строк) Обрабатывать надо все файлы XLS из выбранной папки, или надо выбирать отдельные файлы из этой папки? |
11.11.2010, 15:42 | #3 |
Регистрация: 11.11.2010
Сообщений: 6
|
Спасибо за ваше участие! Файл xls всего один, но с множеством листов. Надо собрать их в новый документ на один лист, чтобы потом его потом можно преобразовать в текстовый.
Прикладываю пример |
11.11.2010, 18:03 | #4 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Не совсем то, что вам надо, но всё же...
1) Откройте свой файл ("исходный"), и мой файл (с макросом) ВНИМАНИЕ: не должно быть открыто других файлов) 2) в моём файле нажмите зелёную кнопку PS: Обработку столбцов (объединение, форматирование, перестановку столбцов) не делал. Вот весь код: Код:
__Полезные надстройки для Excel. Парсинг сайтов и файлов.
Макросы любой сложности на заказ. Мониторинг цен конкурентов Последний раз редактировалось EducatedFool; 11.11.2010 в 18:06. |
11.11.2010, 20:03 | #5 |
Регистрация: 11.11.2010
Сообщений: 6
|
Спасибо большое - это макрос гораздо легче понять, а комментарии помогут сделать остальное. Вы настоящий джедай VBA!
|
12.11.2010, 16:23 | #6 |
Регистрация: 11.11.2010
Сообщений: 6
|
Возник еще один вопрос по работе макроса, при его использовании в половине ячеек с датами месяц и день поменялись местами и выглядит это так 7/16/2010, а другие в том же столбце остались как и были в нужном формате 08.12.2010. В исходном документе все даты вида чч.мм.гггг.
Не подскажите чем - это вызвано и как исправить? |
12.11.2010, 16:58 | #7 |
Регистрация: 11.11.2010
Сообщений: 6
|
Присмотрелся внимательнее - инвертировались те даты где значение день>12, таким образом как то сработал авто формат по типу западных дат.
Вопрос как это исправить остается в силе. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Объединение книг и листов по имени листа | MaxxVer | Microsoft Office Excel | 8 | 14.01.2011 13:09 |
Объединение данных с нескольких листов в один | Clockgen | Microsoft Office Excel | 10 | 03.11.2010 06:36 |
Побайтовое чтение с редактированием | DedBoroda | Общие вопросы Delphi | 1 | 22.10.2010 02:48 |
Объединение книг и некоторых листов ? | vovik07 | Microsoft Office Excel | 5 | 20.05.2010 11:52 |
Помогите с редактированием! | kotre | Microsoft Office Excel | 4 | 25.05.2009 11:47 |