Возможно ускорит отключение пересчёта, если там на листе есть формулы. Но я бы делал удаление всех строк одним действием - т.е. сперва весь анализ, пометки в массив, его выгружаем на лист, затем удаление сразу всего помеченного.
Возможно ускорит отключение пересчёта, если там на листе есть формулы. Но я бы делал удаление всех строк одним действием - т.е. сперва весь анализ, пометки в массив, его выгружаем на лист, затем удаление сразу всего помеченного.Hugo
Вот, потестите. На базе кода shanemac51 Чтоб ускорить анализ - цвет проверяю только у тех, у кого не 0 [vba]
Код
Sub Macros4() ''обычно удаление идет с хвоста Dim tm! tm = Timer Application.ScreenUpdating = False Dim a(), i As Long, strS As String i = Range("F" & Rows.Count).End(xlUp).Row a = Range("F1:F" & i).Value ReDim b(1 To i, 1 To 1)
'анализ======================= Do While i > 24 If a(i, 1) = 0 Then b(i, 1) = 1 Else If Cells(i, 6).Interior.ColorIndex = 48 Then b(i, 1) = 1 End If End If i = i - 1 Loop
'удаление==================== Dim x As Range Rows.Hidden = False 'на всякий случай, чтоб никто не спрятался [t1].Resize(UBound(b)) = b Set x = [T:T].Find(1, , , xlWhole) If Not x Is Nothing Then [T:T].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If
Application.ScreenUpdating = True Debug.Print "Строки удалены за " & Timer - tm & " сек" End Sub
[/vba]
Вот, потестите. На базе кода shanemac51 Чтоб ускорить анализ - цвет проверяю только у тех, у кого не 0 [vba]
Код
Sub Macros4() ''обычно удаление идет с хвоста Dim tm! tm = Timer Application.ScreenUpdating = False Dim a(), i As Long, strS As String i = Range("F" & Rows.Count).End(xlUp).Row a = Range("F1:F" & i).Value ReDim b(1 To i, 1 To 1)
'анализ======================= Do While i > 24 If a(i, 1) = 0 Then b(i, 1) = 1 Else If Cells(i, 6).Interior.ColorIndex = 48 Then b(i, 1) = 1 End If End If i = i - 1 Loop
'удаление==================== Dim x As Range Rows.Hidden = False 'на всякий случай, чтоб никто не спрятался [t1].Resize(UBound(b)) = b Set x = [T:T].Find(1, , , xlWhole) If Not x Is Nothing Then [T:T].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If
Application.ScreenUpdating = True Debug.Print "Строки удалены за " & Timer - tm & " сек" End Sub
Или так - чуть дольше, но зато на один массив меньше (меньше расход памяти): [vba]
Код
Sub Macros5() Dim tm!: tm = Timer Dim a(), i As Long, t As Long
t = Range("F" & Rows.Count).End(xlUp).Row a = Range("F1:F" & t).Value
'анализ======================= For i = 24 To t If a(i, 1) = 0 Then a(i, 1) = "todel" Else If Cells(i, 6).Interior.ColorIndex = 15 Then a(i, 1) = "todel" End If Next
'удаление==================== Dim x As Range: Rows.Hidden = False 'на всякий случай, чтоб никто не спрятался Application.ScreenUpdating = False: [t1].Resize(t) = a: Set x = [T:T].Find("todel", , , xlWhole) If Not x Is Nothing Then [T:T].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If [T:T].ClearContents: Application.ScreenUpdating = True Debug.Print "Строки удалены за " & Timer - tm & " сек" End Sub
[/vba]
Или так - чуть дольше, но зато на один массив меньше (меньше расход памяти): [vba]
Код
Sub Macros5() Dim tm!: tm = Timer Dim a(), i As Long, t As Long
t = Range("F" & Rows.Count).End(xlUp).Row a = Range("F1:F" & t).Value
'анализ======================= For i = 24 To t If a(i, 1) = 0 Then a(i, 1) = "todel" Else If Cells(i, 6).Interior.ColorIndex = 15 Then a(i, 1) = "todel" End If Next
'удаление==================== Dim x As Range: Rows.Hidden = False 'на всякий случай, чтоб никто не спрятался Application.ScreenUpdating = False: [t1].Resize(t) = a: Set x = [T:T].Find("todel", , , xlWhole) If Not x Is Nothing Then [T:T].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If [T:T].ClearContents: Application.ScreenUpdating = True Debug.Print "Строки удалены за " & Timer - tm & " сек" End Sub
Но в этом случае удалит не только светло-серые строки, но и светло-коричневые (59 - аксессуары и 65 - услуги), а это надо? колориндес у них одинаковый, а колЕр - разный.
Цитата (Hugo)
Да, вместо 48 нужно писать 15!
Но в этом случае удалит не только светло-серые строки, но и светло-коричневые (59 - аксессуары и 65 - услуги), а это надо? колориндес у них одинаковый, а колЕр - разный. Michael_S
Да, я все-равно в код вставлял не Interior.ColorIndex = 15, а Interior.Color = RGB(191, 191, 191), пока, благодаря Michael_S не обнаружил, что первый вариант (Interior.ColorIndex = 15) работает значительно шустрее!! Спасибо Michael_S ! А чтобы не удалялись какие-нибудь нужные строки, пришлось в условии все-таки поменять критерий 0 на "0". Так работает медленнее, примерно секунд 15 вычисляет, но оставляет серые строки, в которых есть какой-то текст, а в столбце "F" пусто, что и надо сделать. Если оставить критерий 0, то
Цитата (Michael_S)
удалит не только светло-серые строки, но и светло-коричневые
Правда есть мысль отказаться от поиска по цвету, оставить критерий 0, но в столбцах "F", которые не надо удалять спрятать например "-" мелко-мелко..) Не нравится только отсутствие изящности решения. Зато макрос работает около 5 сек, то, что надо! Спасибо Hugo за макрос! А также shanemac51 за идею, и конечно же AlexM спасибо большое!
Цитата (Hugo)
Ну в общем это непринципиально
Да, я все-равно в код вставлял не Interior.ColorIndex = 15, а Interior.Color = RGB(191, 191, 191), пока, благодаря Michael_S не обнаружил, что первый вариант (Interior.ColorIndex = 15) работает значительно шустрее!! Спасибо Michael_S ! А чтобы не удалялись какие-нибудь нужные строки, пришлось в условии все-таки поменять критерий 0 на "0". Так работает медленнее, примерно секунд 15 вычисляет, но оставляет серые строки, в которых есть какой-то текст, а в столбце "F" пусто, что и надо сделать. Если оставить критерий 0, то
Цитата (Michael_S)
удалит не только светло-серые строки, но и светло-коричневые
Правда есть мысль отказаться от поиска по цвету, оставить критерий 0, но в столбцах "F", которые не надо удалять спрятать например "-" мелко-мелко..) Не нравится только отсутствие изящности решения. Зато макрос работает около 5 сек, то, что надо! Спасибо Hugo за макрос! А также shanemac51 за идею, и конечно же AlexM спасибо большое!Voh
Упс, я там последний код не так запостил - сейчас подправлю... Перепутал коды - там если использовать исходный массив, то нельзя ставить единицы! Метка должна быть такой, какая не может встретиться в столбце.
Упс, я там последний код не так запостил - сейчас подправлю... Перепутал коды - там если использовать исходный массив, то нельзя ставить единицы! Метка должна быть такой, какая не может встретиться в столбце.Hugo
Они раскрашены вручную для контрастности, удобства визуального восприятия, но цвета едины во всех подобных файлах, которых много и раскрашены уже очень давно, пользователи успели привыкнуть.
Цитата (Michael_S)
А кто и по какому критерию раскрашивает строки?
Они раскрашены вручную для контрастности, удобства визуального восприятия, но цвета едины во всех подобных файлах, которых много и раскрашены уже очень давно, пользователи успели привыкнуть.Voh
Если поставить метки в те строки, которые нужно оставить - то можно Но вообще конечно и тут возможны варианты - например использовать формулы и удалять их. Или формулы с ошибками - и удалять такие строки. Но это дольше. Или выгружать массив b() с константами и удалять строки с константами. Будет код на одну строку короче.
Если поставить метки в те строки, которые нужно оставить - то можно Но вообще конечно и тут возможны варианты - например использовать формулы и удалять их. Или формулы с ошибками - и удалять такие строки. Но это дольше. Или выгружать массив b() с константами и удалять строки с константами. Будет код на одну строку короче.Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
