преобразовать формулу в макрос

[SAS888]

Макрос в варианте 1 не планировалось использовать при фильтрации по цвету. Я его делал в Excel 2003.

...вариант 1 предпочтительнее тк там перерасчет полный идет на листе при изм любой ячейки

Здесь не понятно. Пересчет ВСЕХ ячеек в диапазоне "U8:U1000" будет произведен при изменении любой влияющей (влияющих) ячейки. Т. е. в диапазоне "N8:N1000", "O8:O1000", S8:S1000" или "U8:U1000". Зачем пересчитывать ЭТИ ячейки в случае, если изменились данные в каких-то других ячейках?

[brik]

Здесь не понятно. Пересчет ВСЕХ ячеек в диапазоне "U8:U1000" будет произведен при изменении любой влияющей (влияющих) ячейки. Т. е. в диапазоне "N8:N1000", "O8:O1000", S8:S1000" или "U8:U1000". Зачем пересчитывать ЭТИ ячейки в случае, если изменились данные в каких-то других ячейках?

сорри за мою безграмотность - неправильно понял


так вот макрос по варианту 2 изменил - сейчас пересчитывает нормально при изменении ячеек в диапазоне
1)при стирании заполненных ячеек - когда N стираешь + 2)когда строка пустая заносишь по ошибке сначала в O или S

- но одна бяка что долго

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Range, i As Integer, a(), b(), c(): Set x = Selection
If Intersect(Target, [N8:N1000, O8:O1000, S8:S1000, U8:U1000]) Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False: .EnableEvents = False
a = [N8:N1000].Value: b = [O8:O1000].Value: c = [S8:S1000].Value
For i = 1 To UBound(a, 1)
If a(i, 1) <> "" Then Cells(i + 7, "U") = a(i, 1) - b(i, 1) - c(i, 1)
Next
For i = 1 To UBound(a, 1)
If a(i, 1) = "" Then Cells(i + 7, "U") = ""
Next
For i = 1 To UBound(a, 1)
If a(i, 1) = "" Then Cells(i + 7, "S") = ""
Next
For i = 1 To UBound(a, 1)
If a(i, 1) = "" Then Cells(i + 7, "O") = ""
Next
.ScreenUpdating = True: .EnableEvents = True: x.Select
End With
End Sub

можно его както упростить чтоб быстрее работал?


Макрос по варианту 1 работает быстрее конечно жалко что снятие фильтрацию по цвету не воспринимает

[SAS888]

Посмотрите пример во вложении.

[SAS888]

Еще вариант:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Range, y As Range
    Set x = Intersect(Target, [N8:N1000, O8:O1000, S8:S1000, U8:U1000])
    If x Is Nothing Then Exit Sub
    With Application
        .ScreenUpdating = False: .EnableEvents = False
        For Each y In Intersect(x.EntireRow, Columns("N"))
            If y = "" Then
                y.Offset(, 1) = "": y.Offset(, 5) = "": y.Offset(, 7) = ""
            Else
                y.Offset(, 7) = y - y.Offset(, 1) - y.Offset(, 5)
            End If
        Next
        .ScreenUpdating = True: .EnableEvents = True
    End With
End Sub

Перебираем не весь диапазон, а только строки с измененными значениями. Так существенно быстрее.

[brik]

последний вариант то что надо все работает и без тормозов !
(в варианте книга5 условие если N пусто а O или S заполнено не сработало)

Еще раз тысяча благодарностей что уделили внимание теме !