В примере код с зануленными данными для примера, содержит несколько строк. Фактически 6 файлов источников по 10-15 листов в каждом, итого на выходе 60 000 полузаполненных строк получается. Маленький код работает нормально, об этом и речь, как изменить/расширить на большой объем обработки.
skais675 код не помог, проблема осталась, слишком много строк для обработки, за 15 минут так и не сработал. При этом, если ставить небольшой диапазон: Range("F2:F60"), то все работает. Возможно, каким-либо образом изменить, чтобы макрос обрабатывал 60 тыс. строк недолго по времени?
Или можно добавить в исходный код на консолидацию данных условие, чтобы данные с файлов-источников собирались при условии "если не пусто в определенном столбце, то берем данную строку из данного листа и файла в наш консолидированный отчет"?
Код
Sub svod()
switch_off
this_wb = ThisWorkbook.Name
' используется для получения имени книги, в которой код записан или хранится в модуле этой книги. Если вы пишете код в модуле или листе книги A , то Thisworkbook.name вернет A независимо от того, какая книга является activeworkbook
path_ = "C:\Users\diyanovabd\Desktop\Новая папка\" ' путь к папке
array_ = Array("2021_Производительность ГАП_ПФ.xlsx", "2021_Производительность ГПО_ПФ.xlsx", "2021_Производительность ГПХ_ПФ.xlsx") ' массив данных в папке
str_ = 2 ' начинаем со строки 2
For Each file_ In array_ ' для каждого файла в массиве
open_wb_path = path_ & file_ ' путь к файлу
Workbooks.Open Filename:=open_wb_path, UpdateLinks:=False, Local:=True ' Workbooks.Open Filename:= "Название файла, который находится в папке, путь к которой указан выше"
For i = 1 To Workbooks(file_).Sheets.Count
If Workbooks(file_).Sheets(i).Range("D1").Value = "ФИО менеджера:" Then 'Выбор листов с ФИО менеджера
Workbooks(this_wb).Sheets("СМБ").Range("A" & str_ & ":A" & str_ + 1499).Value = _
file_ 'Файл
Workbooks(this_wb).Sheets("СМБ").Range("B" & str_ & ":B" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("A4:A1503").Value 'Менеджер
Workbooks(this_wb).Sheets("СМБ").Range("C" & str_ & ":C" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("E4:E1503").Value 'ИНН
Workbooks(this_wb).Sheets("СМБ").Range("D" & str_ & ":D" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("G4:G1503").Value 'Клиент
Workbooks(this_wb).Sheets("СМБ").Range("E" & str_ & ":E" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("F4:F1503").Value 'ЛС
Workbooks(this_wb).Sheets("СМБ").Range("F" & str_ & ":F" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("D4:D1503").Value 'Продукт
Workbooks(this_wb).Sheets("СМБ").Range("G" & str_ & ":G" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("L4:L1503").Value 'Дата активации
Workbooks(this_wb).Sheets("СМБ").Range("H" & str_ & ":H" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("M4:M1503").Value 'Статус
Workbooks(this_wb).Sheets("СМБ").Range("I" & str_ & ":I" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("J4:J1503").Value 'Кол-во услуг, шт.
Workbooks(this_wb).Sheets("СМБ").Range("J" & str_ & ":J" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("K4:K1503").Value 'Ежемес
Workbooks(this_wb).Sheets("СМБ").Range("K" & str_ & ":K" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("P4:P1503").Value 'Инсталл
Workbooks(this_wb).Sheets("СМБ").Range("L" & str_ & ":L" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("N4:N1503").Value 'Оборудование, шт.
Workbooks(this_wb).Sheets("СМБ").Range("M" & str_ & ":M" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("O4:O1503").Value 'Выручка оборудование
Workbooks(this_wb).Sheets("СМБ").Range("N" & str_ & ":N" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("Q4:Q1503").Value 'Комментарий
str_ = str_ + 1499
End If
Next i
Workbooks(file_).Close
Next file_
switch_on
End Sub
Sub DeleteRows()
Dim rng As Range, value, i As Long
Application.ScreenUpdating = False
Set rng = Range("F2:F60000")
For i = rng.Rows.Count To 1 Step -1
value = rng.Cells(i, 1).value
If (value = 0) Then
rng.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
MsgBox "Готово", vbInformation
End Sub
Добрый день!
Помогите, пожалуйста, разобраться. Макрос работает только на небольшой массив данных, но если указывать весь диапазон, то обработка не заканчивается. Как возможно изменить или упростить решение?
Помогите, пожалуйста, разобраться. Цель - создать консолидированный файл на основании данных нескольких листов из других файлов-источников. Проблема в том, что источники ссылаются на недоступный моему доступу отчет, и макрос не может обновить данные, т.к. не все связи работают. Каким образом можно доработать мой макрос, чтобы все связи в источниках разорвать перед обработкой файла?
Код
Sub svod()
this_wb = ThisWorkbook.Name
path_ = "C:\Users\diyanovabd\Desktop\Новая папка (2)\"
array_ = Array("2021_Производительность ГАП_ПФ.xlsx", "2021_Производительность ГПО_ПФ.xlsx")
str_ = 2
For Each file_ In array_
open_wb_path = path_ & file_
Workbooks.Open Filename:=open_wb_path
For i = 1 To Workbooks(file_).Sheets.Count
If Workbooks(file_).Sheets(i).Range("D1").Value = "ФИО менеджера:" Then Ю
Workbooks(this_wb).Sheets("Выгрузка").Range("A" & str_ & ":A" & str_ + 1499).Value = _
file_
Workbooks(this_wb).Sheets("Выгрузка").Range("B" & str_ & ":AI" & str_ + 1499).Value = _
Workbooks(file_).Sheets(i).Range("A4:AH1503").Value
str_ = str_ + 1499
End If
Next i
Workbooks(file_).Close
Next file_
End Sub