| Главная » Статьи » Готовые макросы |
Переворот выделенного диапазона по столбцам.
| Sub Reverse_Range() 'Переворачиваем выделенный диапазон (по столбцам последовательно) Dim iTimer As Single Dim cell As Range, ourRange As Range Dim i As Long, rangecellscount As Long Dim LourRange() As Variant On Error Resume Next Set ourRange = Application.InputBox("Укажите диапазон для очистки ячеек:", "Запрос данных", "", Type:=8) If ourRange Is Nothing Then 'нажата кнопка Отмена - диапазон не выбран MsgBox "Диапазон не выбран. Работа прекращена.", vbExclamation Exit Sub End If iTimer = Timer Call AccelerationMacro(True) LourRange = ourRange orcc = ourRange.Columns.Count For k = 1 To orcc rangecellscount = UBound(LourRange) For i = 0 To rangecellscount - 1 ourRange.Cells(i + 1, k) = LourRange(rangecellscount - i, k) Next Next Call AccelerationMacro(False) Set ourRange = Nothing MsgBox "Время выполнения макроса: " & Format((Timer - iTimer) / 86400, "Long Time"), vbExclamation, "" End Sub 'включаем выключаем ускорение макросов Public Function AccelerationMacro(On_v_Off As Boolean, Optional ScreenUdating As Boolean = False, _ Optional Calculation As Integer = xlCalculationManual, Optional EnableEvents As Boolean = False, _ Optional DisplayAlerts As Boolean = False, Optional DisplayStatusBar As Boolean = False) If On_v_Off = True Then 'Больше не обновляем страницы после каждого действия If ScreenUdating = False Then Application.ScreenUpdating = False 'Отключаем события If EnableEvents = False Then Application.EnableEvents = False 'Расчёты переводим в ручной режим If Calculation = xlCalculationManual Then Application.Calculation = xlCalculationManual 'Отключаем сообщения Excel If DisplayAlerts = False Then Application.DisplayAlerts = False 'Отключаем статусную строку If DisplayStatusBar = False Then Application.DisplayStatusBar = False Else Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True Application.DisplayStatusBar = True End If End Function | |
| Просмотров: 658 | | |
| Всего комментариев: 0 | |