Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Автоматический сбор данных со всех листов книги на один лист
 
#1
02.11.2011 11:48:37
Добрый день знатоки Экселя!  
Помогите решить мою проблему.  
Есть таблица - её заполняют руководители.  
Каждый руководитель заполняет свой лист.  
Таблица на каждом листе одинаковая - количество столбцов одинаковое, разное количество строк, их количество каждый раз меняется.  
Задача автоматом собирать данные со всех листов на один общий лист.  
При добавлении строк на отдельных листах - эти строки должны добавляться на общий лист.  
Поиск по форуму не помог - были аналогичные задачи - но мне ни одна не подошла.  
Помогите плиз!
 
 
 
#2
02.11.2011 11:53:49
Оff: а ник-то?!  
Я даже маленько испугался - не забыл ли Pavel55 (Somebody) VBA? :)
 
 
 
#3
02.11.2011 11:58:17
{quote}{login=Pavel5y5}{date=02.11.2011 11:48}{thema=Автоматический сбор данных со всех листов книги на один лист}{post}Поиск по форуму не помог - были аналогичные задачи - но мне ни одна не подошла.{/post}{/quote}Вы правы - таких примеров КУЧА! Почему Вам не подошёл ни один? В раздел "Приемы" заглядывали?
 
 
 
#4
02.11.2011 12:36:04
quote}Вы правы - таких примеров КУЧА! Почему Вам не подошёл ни один? В раздел "Приемы" заглядывали?{/post}{/quote}  
Да "Приёмы" смотрел - есть в разделе макросов ссылка "Сборка листов" - там макрос для сбора илстов с разных книг в одну (не совсем мой случай) и там же ссылка на надстройку Plex: "Автоматическая сборка данных с нескольких листов на один итоговый лист" - вот это мой случай, но надстройку эту надо отдельно устанавливать, к томуже платно - а у нас с этим табу - ничего стороннего ставить нельзя.  
По поиску смотрел - ничего такого не нашёл - если подскажите где посмотреть - буду премного благодарен!
 
 
 
#5
02.11.2011 12:42:47
Какая-то стрёмная задача... Могут быть всякие неожиданности.  
Я бы собирал на общий лист только по особой нужде...  
Но есть например такой вариант - тянем данные динамически при активации листа.  
Так через массив (без форматов ячеек), а в файле - копированием диапазона:  
 
Option Explicit  
Const rrow = 4  
 
Private Sub Worksheet_Activate()  
   Dim a(), sh As Worksheet, ind&  
   Application.ScreenUpdating = False  
 
   Range("a" & rrow & ":ar" & Cells(rrow, 1).End(xlDown).Row).Clear  
   For Each sh In Worksheets  
       With sh  
           If .Index <> ActiveSheet.Index Then  
               a = .Range("a" & rrow & ":ar" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value  
               Cells(rrow + ind, 1).Resize(UBound(a), 44) = a  
               ind = ind + UBound(a)  
           End If  
       End With  
   Next  
   Range(Cells(rrow, 1), Cells(rrow + ind - 1, 44)).Borders.Weight = xlThin  
 
   Application.ScreenUpdating = True  
 
End Sub
 
 
 
#6
02.11.2011 12:43:30
{quote}{login=vikttur}{date=02.11.2011 11:53}{thema=}{post}Оff: а ник-то?!  
Я даже маленько испугался - не забыл ли Pavel55 (Somebody) VBA? :){/post}{/quote}  
Не понял слегка - причём тут мой ник?!  
Про VBA - вообще ни чего не знаю :)  
Вопрос вроде лёгкий - но как показывают примеры - решается он через макросы - а я в этом не силён совсем.  
Скачивал разные примеры, но подогнать их под себя не получается - как поправить макрос - хз.  
Вобщем решил задать сдесь вопрос - может кто поможет, кому не сложно!
 
 
 
#7
02.11.2011 12:45:24
>> но надстройку эту надо отдельно устанавливать, к томуже платно - а у нас с этим табу - ничего стороннего ставить нельзя.  
Смешно - надстройку нельзя, а "сторонний" макрос можно. Надстройка, что по Вашему - не макрос?
 
 
 
#8
02.11.2011 12:48:28
<Не понял слегка - причём тут мой ник?!>  
 
Наберите в окошке поиска по форуму "Pavel55", поймете :)
 
 
 
#9
02.11.2011 13:01:30
{quote}{login=Hugo}{date=02.11.2011 12:42}{thema=}{post}Какая-то стрёмная задача... Могут быть всякие неожиданности.  
Я бы собирал на общий лист только по особой нужде...  
Но есть например такой вариант - тянем данные динамически при активации листа.  
Так через массив (без форматов ячеек), а в файле - копированием диапазона{/post}{/quote}  
Спасибо - вроде оно - сейчас попробывал - всё вроде работает.  
Такая уж у нас таблица - приходится всё собирать на один лист - в итоге строк уже набирается больше тысячи.  
Попробывал добавить один лист - всё работает.  
Если потом добавить ещё с десяток - работать будет?  
Если добавятся столбцы - что то править надо в макросе?  
Ссори за глупые вопросы - я в макросах ни бум-бум!
 
 
 
#10
02.11.2011 13:04:39
{quote}{login=vikttur}{date=02.11.2011 12:48}{thema=}{post}<Не понял слегка - причём тут мой ник?!>  
 
Наберите в окошке поиска по форуму "Pavel55", поймете :){/post}{/quote}  
А - тёзки!  
Почти :)
 
 
 
#11
02.11.2011 13:38:22
Если добавятся/убавятся столбцы - замените в приложенном файле "ar" на букву/ы последнего столбца.  
А в макросе на массиве - ещё и 44 на номер последнего столбца.  
Ещё в коде есть привязка к 4-ой строке (Const rrow = 4) - это неизменная шапка, и к тому, что в первом столбце все строки всюду заполнены.
 
 
 
#12
02.11.2011 14:19:49
{quote}{login=Hugo}{date=02.11.2011 01:38}{thema=}{post}Если добавятся/убавятся столбцы - замените в приложенном файле "ar" на букву/ы последнего столбца.  
А в макросе на массиве - ещё и 44 на номер последнего столбца.  
Ещё в коде есть привязка к 4-ой строке (Const rrow = 4) - это неизменная шапка, и к тому, что в первом столбце все строки всюду заполнены.{/post}{/quote}  
Спасибо большое!  
Хороший макрос - всё работает!  
Внесли кучу данных - всё вроде нормально.  
Не могу только отсортировать по алфавиту - по первому столбцу - хрень какая то, жалуется что не все ячейки имеют одинаковый формат
 
 
 
#13
02.11.2011 14:28:11
Это объединение ячеек шапки мешает.  
Выделите нужные строки целиком и сортируйте.
 
 
 
#14
02.11.2011 15:00:52
Sub Sbor()  
Dim q, p As Long: q = 4: p = 4  
For i = 2 To Sheets.Count  
   With Sheets(i)  
       Do While .Cells(q, 1) <> ""  
           Range(.Cells(q, 1), .Cells(q, 44)).Copy  
           Sheets(1).Cells(p, 1).Select  
           ActiveSheet.Paste  
           q = q + 1  
           p = p + 1  
       Loop  
     q = 4  
   End With  
Next i  
End Sub
 
 
 
#15
02.11.2011 15:20:58
Можно и так.  
Только у меня 3 раза копируется (по количеству листов), а у Николая 1000 (по количеству строк).  
И моему варианту безразлично положение листа в книге и наличие в книге листов диаграмм.  
Так же есть разница при наличии пустых ячеек в первом столбце (вообще таких не должно быть).  
В остальном особых отличий нет (если убрать Select и моргания).
 
 
 
#16
02.11.2011 15:33:47
Может попробовать так? Но это только для случая, когда все в одной книге.    
 
Sub Consolidation()  
s_ = Sheets.Count  
Sheets.Add After:=Sheets(s_)  
For i = 1 To s_  
   r_ = Sheets(i).Cells.SpecialCells(xlLastCell).Row  
   Sheets(i).Range("A1", Sheets(i).Cells.SpecialCells(xlLastCell)).Copy Sheets(s_ + 1).Range("a" & n_ + 1)  
   n_ = n_ + r_  
Next  
End Sub
 
 
 
#17
02.11.2011 15:39:28
А шапка?  
И по этой задаче сборный лист уже есть.  
Да и xlLastCell - на практике дело ненадёжное...  
И опять же - вдруг листы диаграмм?  
Но для конкретных задач вполне можно использовать.
 
 
 
#18
02.11.2011 15:47:21
{quote}{login=Hugo}{date=02.11.2011 03:39}{thema=}{post}А шапка?  
И по этой задаче сборный лист уже есть.  
Да и xlLastCell - на практике дело ненадёжное...  
И опять же - вдруг листы диаграмм?  
Но для конкретных задач вполне можно использовать.{/post}{/quote}  
Спасибо за ответы!  
Сделал как советовал Hugo - всё работает.  
Засада как оказалась была в том некоторые менеджеры делали на своих листах объединение некоторых ячеек - из-за этого не работала сортировка.  
Пришлось найти и устранить форматирование.  
Сортировку применяю на общем листе - работает, нужно только каждый раз после изменения на сортировку нажимать.
 
 
 
#19
02.11.2011 16:48:10
Так добавьте сортировку в код.  
Вот, записал рекордером и изменил константы рядов на известные переменные (добавьте эту одну (с переносами) строку в конец кода):  
 
   Rows(rrow & ":" & ind + rrow - 1).Sort Key1:=Range("A" & rrow), Order1:=xlAscending, Header:=xlGuess, _  
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _  
       DataOption1:=xlSortNormal  
 
'это существующий конец кода:  
   Application.ScreenUpdating = True  
 
End Sub  
 
 
И можно кстати ещё это сделать опционально - например проверять в свободной ячейке шапки символ "a" шрифтом marlett (ну или поставить чекбокс из элементов управления) - если галка есть, то сортируем, если нет - выходим из кода (или пропускаем сортировку).  
Это элементарное использование If...Then...Else...End If, пример в коде есть.
 
 
 
#20
03.11.2011 09:12:18
{quote}{login=Hugo}{date=02.11.2011 04:48}{thema=}{post}Так добавьте сортировку в код.  
Вот, записал рекордером и изменил константы рядов на известные переменные (добавьте эту одну (с переносами) строку в конец кода):  
 
   Rows(rrow & ":" & ind + rrow - 1).Sort Key1:=Range("A" & rrow), Order1:=xlAscending, Header:=xlGuess, _  
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _  
       DataOption1:=xlSortNormal  
 
'это существующий конец кода:  
   Application.ScreenUpdating = True  
 
End Sub  
 
 
И можно кстати ещё это сделать опционально - например проверять в свободной ячейке шапки символ "a" шрифтом marlett (ну или поставить чекбокс из элементов управления) - если галка есть, то сортируем, если нет - выходим из кода (или пропускаем сортировку).  
Это элементарное использование If...Then...Else...End If, пример в коде есть.{/post}{/quote}  
Спасибо большое Hugo за проделанную работу - добавил вашу запись в код - все прекрасно работает!  
От меня - РЕСПЕКТ!
 
 
 
Страницы: 1
Читают тему
Наверх