Привет!
Делал замену формул на значения и подстановка макросом формул обратно. Скорость на тысячах строк возрастала наглядно.
Но кодирование было основано на "своеобразных" данных пользователя.
Да, раньше я писал "спагетти" код :-)
Скрытый текст |
---|
Код |
---|
Private Sub Red_Alert_Bad()
' Вписка сложных формул в столбцы 10, 18, 27
' В красных ячейках этих столбцов должна быть специальная формула
' её диапазон зависит от смены содержания ячейки в столбце 5
Dim x As Long, iCol As Long 'arr_Col_Bad() As Variant,
' arr_Col_Bad = Array(10, 18, 27) 'Столбцы с плохими формулами
Dim ws As Worksheet, Row_End As Long
Set ws = ActiveSheet
Row_End = Строка_Крайняя(ws)
With ws
If .FilterMode Then .ShowAllData
Dim rng As Range
Set rng = .Range(.Cells(5, 10), _
.Cells(Row_End, Столбец_Крайний(ws)))
rng.AutoFilter Field:=10, Criteria1:=RGB(255 _
, 0, 0), Operator:=xlFilterCellColor
With rng
'Только видимые
Set rng = .Resize(.Rows.Count, 1). _
SpecialCells(xlCellTypeVisible)
'Обезопасить от пустых, но красных ячеек
If WorksheetFunction.CountA(rng) < .Count Then
.SpecialCells(xlCellTypeBlanks).Value = "0" 'Для xlDown
'Нули_Одинокие_Заменить_на_Пусто (ws)
End If
End With
If .FilterMode Then .ShowAllData ' для работы xlDown
Dim el As Range, Row_Last As Long
Application.StatusBar = "Ячейки красные: сложные формулы ..."
For Each el In rng 'прогулка по красным ячейкам
With el
Row_Last = .End(xlDown).Row - 1 - .Row
.FormulaR1C1 = _
"=IF(RC[-8]=0,0,SUM(RC[-1]:R[" & Row_Last & "]C[-1]))"
' столбец 18
el.Offset(0, .FormulaR1C1 = "=SUM(RC[-1]:R[" & Row_Last & "]C[-1])"
' столбец 27
el.Offset(0, 17).FormulaR1C1 = "=SUM(RC[-1]:R[" & Row_Last & "]C[-1])"
End With
Next
End With
End Sub |
|