powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как быстрее собрать данные из кучи листов?
5 сообщений из 5, страница 1 из 1
Как быстрее собрать данные из кучи листов?
    #34929503
Taranaga
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Нужен совет по ускорению работы таблиц.

Есть файл ексель в нем куча листов с однотипными данными.
Необходимо на отдельный лист (сводный) в томже файле перенести информацию со всех листов (записи одна под другой).

В настоящее время делается так:
1. Вырубаются вычисления
2. Цыкл по листам
3. Цыкл по строкам
4. Цыкл по столбцам
5. Вставка значений ячеек в сводный лист примерно так: Sheets("Сводный").Cells(k,l)=Sheets(sh).cells(i,j)

Все это дело жутко тормозит...
Теперь, собственно вопрос: Какие есть более быстрые способы консолидации данных?
В голову приходят следующие варианты:
1. Отработать все Копи - Пастом
2. Загонять данные листа в массив и вставлять в сводный лист
3. Загонять данные всех листов в массив и уже после этого загонять их в сводный лист
...
Рейтинг: 0 / 0
Как быстрее собрать данные из кучи листов?
    #34929611
Pavel55
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
могу посоветовать это (если вы это не используете)


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
'желательно использовать эту конструкцию в каждом макросе (по возможности)
Sub MyMacro() 
'выключаем некорые параметры для увеличения скорости обработки файла
    With Application 
        .ScreenUpdating = False 'отключение обновление экрана
        .Calculation = xlCalculationManual  'отключение пересчёт формул вручную
        .EnableEvents = False 'отключение событий
        .DisplayAlerts = False 'отключение предупреждающих сообщений
        .ErrorCheckingOptions.BackgroundChecking = False 'отключение фоновой проверки ошибок
    End With

	    'ОСНОВНОЙ КОД....

    With Application 
        .ScreenUpdating = True 
        .Calculation = xlCalculationAutomatic 
        .EnableEvents = True 
        .DisplayAlerts = True
        .ErrorCheckingOptions.BackgroundChecking = True
    End With 
End Sub
...
Рейтинг: 0 / 0
Как быстрее собрать данные из кучи листов?
    #34929756
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Тут основной прирост производительности даст вставка сразу диапазона а не ячейки

Вместо
Код: plaintext
Sheets("Сводный").Cells(k,l)=Sheets(sh).cells(i,j)

нужно определять максимально большие целые куски и работать с ними

Код: plaintext
Sheets("Сводный").Range("A101:N199").value=Sheets(sh).Range("A2:N100").value
...
Рейтинг: 0 / 0
Как быстрее собрать данные из кучи листов?
    #34929928
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот когда-то кому-то уже выкладывал, может пригодится.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
Sub Выбрать_данные()
Dim NewLine As Integer, Col As Integer, ToSheet As Worksheet
Dim Lrow As Long, Frow As Long
Dim ws As Worksheet, FromRangeName As String
   
  
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
   
   '№ Последнего столбца для консолидации, первый считается "A".
   'Дейсвует как для исходных данных, так и для итоговых
   Col =  20 
   'Первая строка в которую заполняются значения
   NewLine =  3 
   'Лист на который будем копировать
   Set ToSheet = ThisWorkbook.Sheets("Лист2")
   'Открытие листа куда заполняются данные
   ToSheet.Select
   'Очистка предыдущих данных
   Range(Cells(NewLine,  1 ), Cells(Rows.Count, Col)).Clear

   'первая строка в диапазоне, которую нужно копировать
   Frow =  3 
      
    For Each ws In ThisWorkbook.Worksheets
     If ws.Name <> ToSheet.Name Then
      'Имя Диапазона, в котором искать последнюю строку
      FromRangeName = Range(Cells( 1 ,  1 ).Address, Cells(Rows.Count, Col).Address).Address
       
       On Error Resume Next
       'нахождение последней строки в диапазоне
        Lrow = ws.Range(FromRangeName).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        If Err.Number =  0  Then
       On Error GoTo  0 
         'Копирование значений диапазона
          ToSheet.Range(Cells(NewLine,  1 ).Address, Cells(NewLine - Frow + Lrow, Col).Address).Value = _
            ws.Range(Cells(Frow,  1 ).Address, Cells(Lrow, Col).Address).Value
          NewLine = NewLine - Frow + Lrow +  1 
        End If
     End If
    Next ws
   
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub
...
Рейтинг: 0 / 0
Как быстрее собрать данные из кучи листов?
    #34930345
Taranaga
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
DeggasadТут основной прирост производительности даст вставка сразу диапазона а не ячейки

Вместо
Код: plaintext
Sheets("Сводный").Cells(k,l)=Sheets(sh).cells(i,j)

нужно определять максимально большие целые куски и работать с ними

Код: plaintext
Sheets("Сводный").Range("A101:N199").value=Sheets(sh).Range("A2:N100").value
Спасибо. Нужно будет попробовать...
А через массив никто не пытался? Или смысла нет?
...
Рейтинг: 0 / 0
5 сообщений из 5, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как быстрее собрать данные из кучи листов?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]