Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос удаления строк по заданному критерию столбца
 
Jack Famous спасибо вам большое!
Макрос удаления строк по заданному критерию столбца
 
В примере код с зануленными данными для примера, содержит несколько строк. Фактически 6 файлов источников по 10-15 листов в каждом, итого на выходе 60 000 полузаполненных строк получается. Маленький код работает нормально, об этом и речь, как изменить/расширить на большой объем обработки.
Макрос удаления строк по заданному критерию столбца
 
Ссылка на консолидированный пример отчета и папку-источник:

https://fex.net/ru/s/94fplt7

Макрос удаления строк по заданному критерию столбца
 
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
Добрый день!

Помогите, пожалуйста, разобраться. Макрос работает только на небольшой массив данных, но если указывать весь диапазон, то обработка не заканчивается.
Как возможно изменить или упростить решение?
Изменено: diyanova - 10.08.2021 07:46:11
Открыть книгу без обновления связей
 
Спасибо!
Изменено: diyanova - 10.08.2021 02:35:27
Открыть книгу без обновления связей
 
Добрый день!

Помогите, пожалуйста, разобраться. Цель - создать консолидированный файл на основании данных нескольких листов из других файлов-источников. Проблема в том, что источники ссылаются на недоступный моему доступу отчет, и макрос не может обновить данные, т.к. не все связи работают. Каким образом можно доработать мой макрос, чтобы все связи в источниках разорвать перед обработкой файла?
Код
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
Изменено: vikttur - 09.08.2021 19:27:26
Страницы: 1
Наверх