Страницы: 1
RSS
Долго форматируется таблица через VBA
 
Ребята, подскажите, в чём может быть проблема. Сделал макрос, который после получения внешних данных на страницу, красиво оформляет её. И, по какой-то непонятной причине, в какие-то периоды, код начинает работать очень долго. Буквально над каждой строчкой кода программа думает по 0,1 секунды, пришлось отключить некоторые настройки. И так на всех компьютерах. Что это может быть? Код ниже.
Код
Sub krasota()
Dim i, a As Integer
Dim t1 As String
On Error GoTo fff


Application.EnableEvents = False
Application.ScreenUpdating = False

Application.StatusBar = "Наводим красоту. Этап 1"
Sheets("Клиенты").Activate
With Sheets("Клиенты")
     i = .Cells(Rows.Count, 3).End(xlUp).Row
     If i > 7 Then
        t1 = "A7" & ":A" & i
        .Range(t1) = "+"
        .Range("A7").Select
        Selection.AutoFill Destination:=Range(t1), Type:=xlFillDefault
        .Range("A" & i + 1 & ":A" & i + 200).ClearContents
    End If
End With

    Application.StatusBar = "Наводим красоту. Этап 2"
    t1 = "C7:O" & i + 50
    Range(t1).Select
    Selection.NumberFormat = "General"
    Cells.Select
    With Selection
 '       .VerticalAlignment = xlTop
 '       .Orientation = 0
 '       .AddIndent = False
        .IndentLevel = -1
 '       .ShrinkToFit = False
 '       .ReadingOrder = xlContext
 '       .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 3"
    Selection.InsertIndent 1
    With Selection.Font
        .name = "Calibri"
        .Size = 11
 '       .Strikethrough = False
 '       .Superscript = False
 '       .Subscript = False
 '       .OutlineFont = False
 '       .Shadow = False
 '       .Underline = xlUnderlineStyleNone
 '       .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = False
    
    Application.StatusBar = "Наводим красоту. Этап 4"
    Columns("S:X").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
    End With
 
Radomir-m, а как проверить вы не полный/не работающий макрос прикрепили
Не бойтесь совершенства. Вам его не достичь.
 
отформатируйте лист-шаблон
после получения данных, поместите их в лист шаблон, как данные
скорее всего уложитесь в 1 сек.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Вот полный макрос
Код
Sub krasota()
Dim i, a As Integer
Dim t1 As String
On Error GoTo fff


Application.EnableEvents = False
Application.ScreenUpdating = False

Application.StatusBar = "Наводим красоту. Этап 1"
Sheets("Клиенты").Activate
With Sheets("Клиенты")
     i = .Cells(Rows.Count, 3).End(xlUp).Row
     If i > 7 Then
        t1 = "A7" & ":A" & i
        .Range(t1) = "+"
        .Range("A7").Select
        Selection.AutoFill Destination:=Range(t1), Type:=xlFillDefault
        .Range("A" & i + 1 & ":A" & i + 200).ClearContents
    End If
End With

    Application.StatusBar = "Наводим красоту. Этап 2"
    t1 = "C7:O" & i + 50
    Range(t1).Select
    Selection.NumberFormat = "General"
    Cells.Select
    With Selection
 '       .VerticalAlignment = xlTop
 '       .Orientation = 0
 '       .AddIndent = False
        .IndentLevel = -1
 '       .ShrinkToFit = False
 '       .ReadingOrder = xlContext
 '       .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 3"
    Selection.InsertIndent 1
    With Selection.Font
        .name = "Calibri"
        .Size = 11
 '       .Strikethrough = False
 '       .Superscript = False
 '       .Subscript = False
 '       .OutlineFont = False
 '       .Shadow = False
 '       .Underline = xlUnderlineStyleNone
 '       .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = False
    
    Application.StatusBar = "Наводим красоту. Этап 4"
    Columns("S:X").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 5"
    Columns("U:W").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
 '       .WrapText = True
 '       .Orientation = 0
 '       .AddIndent = False
 '       .IndentLevel = 0
 '       .ShrinkToFit = False
 '       .ReadingOrder = xlContext
 '       .MergeCells = False
    End With
    Selection.InsertIndent 1
    
    Application.StatusBar = "Наводим красоту. Этап 6"
    Range("A7:AH" & i + 50).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 7"
    Range("B7:B" & i + 50).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 8"
    Range("A6:AH6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 9"
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    
    Application.StatusBar = "Наводим красоту. Этап 10"
    Range("AA6:AH" & i + 50).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 11"
    Range("A7:A" & i + 50).Select
    With Selection.Font
        .name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    
    Application.StatusBar = "Наводим красоту. Этап 12"
    Range("S7:X" & i + 50).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 13"
    Range("Y7:AD" & i + 50).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With

    Application.StatusBar = "Наводим красоту. Этап 14"
    Range("E7:E" & i + 50).Select
    Selection.NumberFormat = "0"
    
    Application.StatusBar = "Наводим красоту. Этап 15"
    t1 = "A6:AH" & i + 50
    Range(t1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    
    Application.StatusBar = "Наводим красоту. Этап 16"
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 17"
    Range("C7:P100").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Application.StatusBar = "Наводим красоту. Этап 18"
    Range("C5").Select
    With Selection.Font
        .Color = -13203165
        .TintAndShade = 0
    End With
    With Selection.Font
        .name = "Calibri"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -13203165
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Worksheets("Клиенты").Cells(i, 3).Select
    Application.StatusBar = "Готово"
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
Exit Sub
fff: MsgBox ("Красоту навести не получилось, может и ничего страшного, но можно обратиться к разработчику"):    Application.ScreenUpdating = True:    Application.EnableEvents = True
End Sub
Изменено: Radomir-m - 24.08.2020 21:01:02
 
Перенес код в новый файл - там работает быстро. А когда перенес сам лист с кодом, работать стал также медленно...
Изменено: Radomir-m - 24.08.2020 21:45:26
 
Попробуйте отключить пересчёт на время работы макроса. То есть в начале добавить строку

Код
Application.Calculation = xlCalculationManual

а в конце макроса
Код
Application.Calculation = xlCalculationAutomatic

P.S. Вместо вот такого кода

Код
    Columns("U:W").Select
    With Selection
     .......    
     End With

Лучше сразу писать

Код
   With Columns("U:W")
.........   
  End With

здесь тоже самое. Вот так не надо

Код
    t1 = "C7:O" & i + 50    
    Range(t1).Select
    Selection.NumberFormat = "General"
    Cells.Select
    With Selection
       .IndentLevel = -1
    End With

Пишите просто
Код
   t1 = "C7:O" & i + 50    
   Range(t1).NumberFormat = "General"
    With Cells
         .IndentLevel = -1
    End With

То есть без Select и Selection. Они не нужны и замедляют работу макроса.
Изменено: New - 24.08.2020 21:52:42
 
Спасибо большое! Сейчас буду испытывать!
 
вместо вот этого кода

Код
    Application.StatusBar = "Наводим красоту. Этап 15"
    t1 = "A6:AH" & i + 50
    Range(t1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

напишите просто

Код
    Application.StatusBar = "Наводим красоту. Этап 15"
    t1 = "A6:AH" & i + 50
    Range(t1).Borders.LineStyle = xlContinuous

и так везде
Изменено: New - 24.08.2020 21:57:23
 
Ну и не помешает проинспектировать список стилей. Избыточное количество стилей может в некоторой мере замедлять работу с файлом Удаление неиспользуемых стилей
 
Да, если на листе очень много стилей и много условного форматирования (особенно наложенного на весь столбец, то есть на все 1 млн строк вниз и таких столбцов много), то тоже будет тормозить всё
Изменено: New - 24.08.2020 21:58:55
 
К сожалению, это ничего не помогло... ни на секунду не ускорился.
 
дайте файл посмотреть (удалите из него всё секретное, или замените на апельсины, бананы)
Вот недавно приходил человек на форум, как вы и говорил - у меня сильно тормозит файл... потом он обнаружил, что в какой-то ячейке длинная формула ссылалась сама на себя (но циклическую ссылку не показывала), человек исправил формулу и файл стал быстро работать.
У кого-то 100.000 битых имён в файле, в кого-то миллиарды условного форматирования - а это летучие формулы - они тормозят файл
Изменено: New - 24.08.2020 22:02:35
Страницы: 1
Наверх