Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
209 вопрос про то, как скопировать данные из нескольких листов на один с помощью VBA
 
#1
17.06.2012 21:52:34
Уважаемые форумчане, я заранее знаю, что вопрос обозначенный в теме, задавался уже не один десяток раз... и обсуждался уже пару сотен раз... НО, я честно прочитал множество веток... я второй день не отрывая задницу от стула и обнявшись с книжкой Уокенбаха пытаюсь решить эту, для многих, видимо, тривиальную задачу... я сдаюсь, я не понимаю КАК? Логика формул Excel в VBA не работает, ну т.е. работает но не зеркально... если бы можно было решить эту задачу не прибегая к VBA - я бы решил... но, тут нужен VBA, а силы мои кончились...  
 
И хотя постановка задачи тривиальна, но все же:  
* Есть книга *.xlsm (во вложении);  
* Есть несколько вкладок (отмечены цветом): "Гор", "Каш", "Вол", "Нау";  
* С каждой из этих вкладок нужно скопировать данные в лист "Лист2" - в данном листе уже заполнена "шапка" - задача скопировать только данные из вышеупомянутых листов;  
* Условие копирования - начиная с первой строки (Строка 3), до последней заполненной (определение последней заполненной строки с горем пополам смог решить - читай найти решение на форуме): Sub CopyManagers5() в модуле Copy в прилагаемом файле;  
* но я не понимаю КАК? реализовать следующее:    
а) диапазон для копирования я выделил, но если я, запуская макрос, нахожусь не на том листе для которого этот макрос написан (в примере макрос для листа "Вол", т.е. иначе говоря лист "Вол" неактивен) - вылетает ошибка...    
б) проблема номер два - ну получилось у меня скопировать данные на лист "Лист2", как заставить макрос перейти на следующий, необходимый мне, лист для выделения и копирования следующего блока данных (перечень листов откуда копировать данные - заранее известен)?    
в) Проблема три: как на этом листе "Лист2" вставить следующий блок данных в след за тем блоком, которые был перенесен с во время первой итерации (чтобы данные копировались на "Лист2" друг за другом)?    
г) Проблема четыре - допустим произошло чудо, все скопировалось как надо на лист "Лист2", как заставить макрос при следующем запуске стереть с этого листа ("Лист2") все данные кроме шапки (предполагается, что упомянутые вкладки будут редактироваться ежедневно)?  
 
Пожалуйста, помогите.  
 
P.S. Архив разбит на 2 части.
 
 
 
#2
17.06.2012 21:53:44
Вторая часть файла (архив)
 
 
 
#3
17.06.2012 22:02:02
б) for each sh in arr  
arr - это массив "перечень листов откуда копировать данные - заранее известен"  
Значение sh подставляем в конструкцию sheets(sh) - будь то индекс или имя.  
в) Вы ведь сказали "определение последней заполненной строки с горем пополам смог решить" - вот и определяйте и копируйте ниже.  
г) аналогично - определяйте и стирайте, или удаляйте строки целиком.  
 
Файлы не смотрел.
 
 
 
#4
17.06.2012 22:12:01
б) Я правильно понимаю логику?  
Dim arr As Range  
Set arr = Worksheets("Вол", "Гор", "Каш", "Нау")  
 
...а sh какой тип определить?
 
 
 
#5
17.06.2012 22:18:39
Вот, вполне человеческая логика :)  
 
 
Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split("Ćīš Źąų Āīė Ķąó")  
   Sheets("Ėčńņ2").Range([AZ3], Range("A" & Rows.Count).End(xlUp)).ClearContents
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Ėčńņ2").Range("A" & Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  
 
 
Остаются вопрос - а не надо ли "убивать" формулы?
 
 
 
#6
17.06.2012 22:19:23
Извините, не уследил...  
 
 
Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split("Гор Каш Вол Нау")  
   Sheets("Лист2").Range([AZ3], Range("A" & Rows.Count).End(xlUp)).ClearContents
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Лист2").Range("A" & Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub
 
 
 
#7
17.06.2012 22:25:05
Справедливо, сам сколько раз поправлял :)  
 
 
   With Sheets("Лист2")  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With
 
 
 
#8
17.06.2012 22:26:10
AcademiC, так дело не пойдёт: Вы полагаете, что, если нельзя 500К, то можно пять по 100? Не верю, что для решения Вашего вопроса нельзя создать небольшой файл-пример.
 
 
 
#9
17.06.2012 22:27:20
Т.е. вот так с "ловлей блох" (ещё одну точку добавил):  
 
 
Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split("Гор Каш Вол Нау")  
   With Sheets("Лист2")  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Лист2").Range("A" & .Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub
 
 
 
#10
17.06.2012 22:30:57
Юрий, справедливо.    
Тем более если в этом файле поудалять все ненужные строки с формулами ниже данных и запаковать в архив - то думаю много и не будет.  
Не проверял, ибо там пароли :(  
Были :)
 
 
 
#11
17.06.2012 23:00:16
Юрий М  
 
Прошу прощения, хотел как лучше...  
 
Hugo  
 
А запороленные листы могут стать проблемой для работы макроса? Специально блокировал листы для изменения, чтобы пользователи не меняли структуру отчета...  
 
Спасибо огромное за помощь, остался только один вопрос - не могу понять что поправить в макросе, чтобы он на листе "Лист2" не затирал шапку...? Сейчас данные вставляются не с 3-ей строчки а со второй + форматирование первой строки (заливка) остается, а вот вся внутрянка (формулы) пропадает...  
 
Что я сделал опять не так?  
 
Sub tt()  
    'Очищаем данные с листа:  
   With Sheets("Лист2")  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With  
    'заполняем лист данными:  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split("Гор Каш Вол Нау")  
   With Sheets("Лист2")  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
   With Sheets(sh)  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Лист2").Range("A" & .Rows.Count).End(xlUp).Offset(1)
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub
 
 
 
#12
17.06.2012 23:11:41
Так, простите... данные с листа и так очищаются - я туплю вставляя блок до коммента "'заполняем лист данными:"... Извините.
 
 
 
#13
17.06.2012 23:12:36
Да, неприятная мелочь. Просто я тестил на листе с уже скопированными данными, не заметил, что на пустом будет такой эффект...  
Можно поставить костыль так -    
 
   With Sheets("Лист2")  
   .[a3] = Now
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With  
 
Или ставить проверку на позицию последней заполненной строки, или иначе делать определение этого диапазона... Но зачем? :)  
Ну а на листе с заполненными данными ошибки не будет, т.е. если в А3 что-то записано, то порядок :)
 
 
 
#14
17.06.2012 23:30:10
Hugo  
 
...не выходит цветок каменный... :-(  
 
Файл во вложении.  
 
Если оставить .[a3] = Now --> затирает часть шапки...при повторном запуске появляется пустая строка...
 
 
 
#15
17.06.2012 23:40:24
Вот так работает:  
 
 
Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split("Гор Каш Вол Нау")  
   With Sheets("Лист2")  
   .[A3] = Now
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
   With Sheets(sh)  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Лист2") _
   .Range("A" & .Rows.Count).End(xlUp).Offset(1)  
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  
 
 
Зачем оффсет меняли?  
.[A2] = Now тоже совершенно ни к чему, там ведь уже есть данные, т.е. в этом действии логики нет.
 
 
 
#16
17.06.2012 23:48:05
Уважаемые форумчане, можете еще раз по коду помочь - я правильно понимаю логику?  
 
Sub tt()  
   Dim arr  
 
' вводим переменную "arr", которая явно не определена, т.е. с типом "variant"  
 
   Application.ScreenUpdating = False  
 
' запрещаем обновление экрана во время работы подпрограммы (sub) для ускорения выполненя  
 
   arr = Split("Гор Каш Вол Нау")  
 
' в справке тьма-тьмущая вариантов "split", я могу только догадываться - это какое-то явное указание листов, которые будут использоваться в данной процедуре?  
 
   With Sheets("Лист2")  
 
' указание одного объекта - "Лист2" над которым планируется совершать ряд операций?  
 
   .[A2] = Now
 
' Что-то типа указания ячейки А2 как ActiveCell?  
 
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
 
' понимаю, что очищает данные на листе "Лист2", но логики работы не понимаю... почему начинаем очищать не с А3, а с AZ23? Почему метод ".End" с константой "xlUp"... не понимаю логики... мы считаем заполненный ячейки снизу?      
 
End With  
   For Each sh In arr  
 
' "sh" - но ведь переменная "sh" неопределена... как это вообще работает?  
 
   With Sheets(sh)  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Лист2") _
   .Range("A" & .Rows.Count).End(xlUp).Offset(2)  
 
' "Offset(2)" - свойство Range, которое задает смещение на 2 строки вниз?  
 
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub
 
 
 
#17
17.06.2012 23:52:17
{quote}{login=Hugo}{date=17.06.2012 11:40}{thema=}{post}Вот так работает  
...................  
.[A2] = Now тоже совершенно ни к чему, там ведь уже есть данные, т.е. в этом действии логики нет.{/post}{/quote}
Hugo, огромнейшее Вам спасибо! Я бы сам это неасилил... в обозримом будущем точно... не могу вкурить я этот язык и логику...
 
 
 
#18
18.06.2012 00:21:40
Split - это разбиваем строку в массив. По умолчанию, если не указано, то по пробелам. Получаем массив  имён листов.  
.[A2] = Now - это в ячейку A2 Sheets("Лист2") заношу сегодняшнюю дату. Вообще не важно что туда нужно занести, но т.к. там даты - пусть будет дата :)
 
.Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents - всё правильно поняли.
Определяем по столбцу A последнюю заполненную ячейку - к ней идём снизу от последней строки вверх :)  
Если в столбце нет пустот - то можно и сверху идти, но надёжнее снизу (не всегда кратчайший путь верный :))  
Ну а как выделять диапазон - всё равно, я выделяю справа налево. т.к. так писать меньше (иначе нужно описать последнюю в AZ исходя от последней в A, что геморнее...)  
 
"sh" не определена - да, забыл. Можете написать    
   Dim arr As Variant  
   Dim Sh As Variant  
но именно As Variant.  
 
С Offset всё верно, кроме того, что нужно 1, а не 2.  
Но это непринципиально :)  
 
А так логика вроде нормальная, всё просто и обоснованно :)
 
 
 
#19
18.06.2012 00:24:17
Вернее Now - это не дата, а именно "сейчас", т.е. дата со временем. Но не суть, форматом показывает дату :)
 
 
 
#20
18.06.2012 00:30:25
{quote}{login=Hugo}{date=18.06.2012 12:21}{thema=}{post}А так логика вроде нормальная, всё просто и обоснованно :){/post}{/quote}  
Еще раз спасибо.  
 
...осталось только понять ЧТО и главное СКОЛЬКО надо скурить, чтобы во всем этом разобраться... формулы, даже замороченные, в Excel как-то попроще давались...
 
 
 
#21
18.06.2012 00:34:09
Мне наоборот.  
Может потому, что я не курю? :)
 
 
 
#22
18.06.2012 10:13:32
Hugo, можно final qustion?  
 
Немного видоизменил условия сбора информации - макрос находится в другом файле в той же папке, где и файл "Отчет".  
 
Методом "тыка" смог обратиться к файлу "Отчет", чтобы макрос собирал данные из него... а как указать, чтобы после сбора данных копирование происходило не в файл "Отчет, а в тот файл, в котором находится макрос (файл с макросом назвал "Сводный.xlsm"?  
 
Конкретно:  
 
 
Sub Sammary2()  
   Dim Manager_lists  
       ChDir "H:\WORK\Отчет"  
       Workbooks.Open Filename:="H:\WORK\Отчет.xls"  
       Application.ScreenUpdating = False  
   With ActiveWorkbook  
   Manager_lists = Split("Гор Каш Вол Нау")  
   End With  
       With Sheets("Сводный")  
           .[A3] = Now
           .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents
       End With  
   For Each sh In Manager_lists  
   With Sheets(sh)  
   .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy Sheets("Ñâîäíûé") _
   .Range("A" & .Rows.Count).End(xlUp).Offset(1)  
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  
 
 
Макрос прерывается с ошибкой на 9 строке ("With Sheets("Сводный")"), что логично, так как в файле Отчет.xls (из которого и собираем данные по листам) нет такого листа как "Сводный", этот лист находится в файле Сводный.xlsm.
 
 
 
#23
18.06.2012 10:29:05
Вообще-то достаточно указать книгу:  
 
With ThisWorkbook.Sheets("Сводный")  
 
Но есть ещё замечания - и по открытию книги (я бы сделал иначе), и по .Rows.Count - теоретически и тут может быть брак.  
Чуть позже напишу свой вариант, как время будет.
 
 
 
#24
18.06.2012 10:47:17
Вот вроде так может быть, без проверки:  
 
Sub Sammary3()  
   Dim Manager_lists, sh, sh_sv As Worksheet  
 
   Manager_lists = Split("Гор Каш Вол Нау")    'получаем массив названий  
   Set sh_sv = ThisWorkbook.Sheets("Сводный")    'получаем ссылку на лист  
     
   Application.ScreenUpdating = False  
     
   With sh_sv  
       .[A3] = Now 'подстраховка от пустого диапазона
       .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).ClearContents 'очистка
   End With  
 
   ChDir "H:\WORK\Отчет" 'это в общем не нужно, но и не мешает  
     
   With Workbooks.Open("H:\WORK\Отчет.xls")    'открываем файл отчёта  
       For Each sh In Manager_lists    'цикл по названиям листов  
           With .Sheets(sh)    'обращаемся к очередному листу  
               .Range(.[AZ3], .Range("A" & .Rows.Count).End(xlUp)).Copy _
                       sh_sv.Range("A" & sh_sv.Rows.Count).End(xlUp).Offset(1) 'копирование  
           End With  
       Next  
       .Close 0    'закрываем отчёт без сохранения изменений (хотя их и не вносили)  
   End With  
 
   Application.ScreenUpdating = True  
End Sub  
 
В этом коде нет ориентации на активную книгу/лист, что надёжнее.  
Ещё вместо Workbooks.Open можно использовать getobject() - тогда не будет ошибки, если эта книга уже открыта. Но тогда нужно подумать, что делать в конце, если она была открыта :)
 
 
 
#25
18.06.2012 12:53:13
Hugo, спасибо все работает.  
 
...буду разбираться в коде и применяемых методах...
 
 
 
Страницы: 1
Читают тему
Наверх