Здравствуйте, форумчане!
Помогите, пожалуйста, в очередной раз с Excel.
Я (не без вашей помощи ) написала макрос, который работает на моих примерах в 10-20 строк.
Но когда я перенесла только первую команду в рабочую таблицу в 100 000 строк и решила проверить, как он работает, оказалось, что он не работает вообще.
Крутится "колёсико", макрос выполняет задание бесконечно долго, в течение минут 40 крутился, так и не выполнил, я прервала его Esc.
Это только первая операция по переносу на другой лист. У меня таких же действий планируется 5, каждый раз надо будет переносить по определенному критерию.
Я нашла информацию, как ускорить код, вставила в свой макрос все команды, которые отключают автоматический пересчет, отключение обновления экрана и всё-всё, что нашла, но результата я так и не увидела...
Помогите, пожалуйста, в очередной раз с Excel.
Я (не без вашей помощи ) написала макрос, который работает на моих примерах в 10-20 строк.
Но когда я перенесла только первую команду в рабочую таблицу в 100 000 строк и решила проверить, как он работает, оказалось, что он не работает вообще.
Крутится "колёсико", макрос выполняет задание бесконечно долго, в течение минут 40 крутился, так и не выполнил, я прервала его Esc.
Код |
---|
Option Explicit Sub perenos1() Dim i As Long Dim last As Long Dim last1 As Long Dim found As Range Dim word1 As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False If Workbooks.Count Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False End If Application.DisplayStatusBar = False Application.DisplayAlerts = False last = Worksheets("Выгрузка").Cells(Rows.Count, 70).End(xlUp).Row last1 = Worksheets("Лист").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To last word1 = "*Ошибка*" Set found = Worksheets("Выгрузка").Cells(i, 70).Find(word1) If Not found Is Nothing Then Worksheets("Лист").Cells(last1 + 1, 1).Resize(, 30).Value = Worksheets("Выгрузка").Cells(i, 70).Resize(, 30).Value last1 = last1 + 1 End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True If Workbooks.Count Then ActiveWorkbook.ActiveSheet.DisplayPageBreaks = True End If Application.DisplayStatusBar = True Application.DisplayAlerts = True End Sub |
Это только первая операция по переносу на другой лист. У меня таких же действий планируется 5, каждый раз надо будет переносить по определенному критерию.
Я нашла информацию, как ускорить код, вставила в свой макрос все команды, которые отключают автоматический пересчет, отключение обновления экрана и всё-всё, что нашла, но результата я так и не увидела...