Форум по VBA, Excel и Word

Sub Clearing()
Dim E As String

        Application.ScreenUpdating = False 'отключение обновления экрана
        Application.Application.EnableEvents = False 'отключение обработки событий
        Application.DisplayAlerts = False 'отключение запросов программы
        Application.Calculation = xlManual 'отключение автоматического расчета ячеек
        Application.DisplayStatusBar = False 'отключение отображения значений в статусной строке

Worksheets("Вагжановская").Activate
    E = Cells.Find("end", , , , xlByRows, xlPrevious).Row
    Range(Cells(56, 4), Cells(E - 1, 27)).SpecialCells(xlCellTypeConstants, 23).ClearContents
Worksheets("Пролетарская").Activate
    E = Cells.Find("end", , , , xlByRows, xlPrevious).Row
    Range(Cells(56, 4), Cells(E - 1, 27)).SpecialCells(xlCellTypeConstants, 23).ClearContents
Worksheets("№1").Activate
    E = Cells.Find("end", , , , xlByRows, xlPrevious).Row
    Range(Cells(56, 4), Cells(E - 1, 27)).SpecialCells(xlCellTypeConstants, 23).ClearContents

        Application.DisplayStatusBar = True 'включение отображения значений в статусной строке
        Application.Calculation = xlAutomatic 'включение автоматического расчета ячеек
        Application.Application.EnableEvents = True 'включение обработки событий
        Application.DisplayAlerts = True 'включение запросов программы
        Application.ScreenUpdating = True 'включение обновления экрана
End Sub

Sub Clearing()

    ' Отключение событий.
    Application.ScreenUpdating = False 'отключение обновления экрана
    Application.Application.EnableEvents = False 'отключение обработки событий
    Application.DisplayAlerts = False 'отключение запросов программы
    Application.Calculation = xlManual 'отключение автоматического расчета ячеек
    Application.DisplayStatusBar = False 'отключение отображения значений в статусной строке
   
    '1. Удаление константных значений.
    УдалитьЗначения "Вагжановская"
    УдалитьЗначения "Пролетарская"
    УдалитьЗначения "№1"
   
    ' Включение событий.
    Application.DisplayStatusBar = True 'включение отображения значений в статусной строке
    Application.Calculation = xlAutomatic 'включение автоматического расчета ячеек
    Application.EnableEvents = True 'включение обработки событий
    Application.DisplayAlerts = True 'включение запросов программы
    Application.ScreenUpdating = True 'включение обновления экрана
   
End Sub

Private Sub УдалитьЗначения(ИмяЛиста As String)

    Dim sh As Worksheet, rng As Range
    Dim lr As Long
   
   
    '1. Присваиваем листу имя "sh". Далее в коде будем обращаться к листу по этому имени.
        ' Может быть так будет удобнее писать и читать код.
    Set sh = Worksheets(ИмяЛиста)
   
    '2. Поиск низа данных по слову "end".
    lr = sh.Cells.Find(What:="end", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
    lr = lr - 1
       
    '3. Присваиваем имя "rng" фрагментам, в которых находятся константы.
        ' Если констант нет, то произойдёт run-ошибка, поэтому строка кода
        ' помещается в перехватчик ошибок.
    On Error Resume Next
    Set rng = sh.Range(sh.Cells(56, 4), sh.Cells(lr, 27)).SpecialCells(xlCellTypeConstants, 23)
    On Error GoTo 0
   
    '4. Очистка ячеек, в которых константы.
        ' Если констант нет, то в переменной "rng" будет слово "Nothing".
    If Not rng Is Nothing Then
        rng.ClearContents
    End If
   
End Sub