Экран Экран мерцает много, несмотря на Application.DisplayAlerts = False

Question

Я использую excel VBA для создания нового листа, а затем копирую данные с другого листа на этот новый лист, который я создал. Затем я буду форматировать новый лист, удалив некоторые столбцы и текстовую упаковку. Это хорошо работает. Однако это не эффективно: экран мерцает так сильно, несмотря на использование Application.DisplayAlerts = False, Application.EnableEvents = False.
Любая помощь?

Sub ProcessPostingData() 
    Dim MyDateTime As String 
    Dim szToday As String 
    Dim szTime As String 
    Dim TD, TM As String 
    Dim AfterFilterFinalRow As Long 
    Dim lLastRow3nd As Long 


    Application.DisplayAlerts = False 
    Application.EnableEvents = False 

    On Error Resume Next 
    Sheets("szTempNow").Delete 
    On Error GoTo 0 
    Sheets.Add().Name = "szTempNow" 

    Worksheets("DATA_PROCESSING").Select 

     lLastRow3nd = Cells(1, 6).EntireColumn.Find("*", SearchDirection:=xlPrevious).Row 

    'We sort,create sheet with DateTime stamp,copy data to new sheet and format 

    ActiveWorkbook.Worksheets("DATA_PROCESSING").Range(Cells(1, 1), Cells(lLastRow3nd, 10)).Sort _ 
    Key1:=Range("A1"), Header:=xlYes 


    With Worksheets("DATA_PROCESSING") 
      AfterFilterFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    End With 

    Sheets("DATA_PROCESSING").Range("A1:J1").Copy Destination:=Sheets("szTempNow").Range("A1") 
    Sheets("szTempNow").Range("A2:J" & AfterFilterFinalRow).Value = Sheets("DATA_PROCESSING").Range("A2:J" & AfterFilterFinalRow).Value 

    Sheets("DATA_PROCESSING").Range(Cells(2, 1), Cells(AfterFilterFinalRow, 10)).EntireRow.Delete 

    'Removing columns not needed and formating 
    Sheets("szTempNow").Select 

     'With Sheets("szTempNow") 
     .Columns("G:G").Delete Shift:=xlToLeft 
     .Columns("D:E").Delete Shift:=xlToLeft 
    End With 

     'With Range(Cells(1, 1), Cells(AfterFilterFinalRow, 10)) 

      '.HorizontalAlignment = xlGeneral 
      '.VerticalAlignment = xlCenter 
      '.WrapText = True 
      '.ReadingOrder = xlContext 
     'End With 

     'Range("E2:E" & AfterFilterFinalRow).Columns("E:E").ColumnWidth = 70 

    'Rename Sheet with Todays date and Time 

    szTime = Format(Time, "h-mm AM/PM") 
    szToday = Format(Now(), "dd-mmm-yyyy") 
     TD = "D" 
     TM = "T" 

    MyDateTime = TD & szToday & TD & "_" & TM & szTime & TM 

     ActiveSheet.Name = MyDateTime 

     Range("K1").Value = ActiveSheet.Name 

     Range("K1").Font.Bold = True 
     With Range("K1") 
      .HorizontalAlignment = xlGeneral 
      .VerticalAlignment = xlCenter 
      .ReadingOrder = xlContext 
     End With 

     Application.EnableEvents = False 
     Application.DisplayAlerts = True 
    End Sub 

Answer 1

Вы ищете:

Application.ScreenUpdating = False 

Это тот, который помогает остановить мерцание экрана, а также может ускорить обработку. Application.DisplayAlerts подавляет диалоги по строкам «Эта книга без изменений».