Пересчет формул

[Uralmaster]

Работает макрос так
Ячейка С11 (только текстовые данные)заполнена напротив в ячейках G11 H11 I11 находятся образцы формул
Ввожу текст в ячейку С12 - формулы появляются в ячейках G12 H12 I12;
Ввожу текст в ячейку С13 - формулы появляются в ячейках G13 H13 I13;
и тд
Если стер текст ( из ячейки допустим С13) - формулы в ячейках G13 H13 I13 убираются
Если стер формулы из ячеек G13 H13 I13 то при вводе нового текста в ячейку С13 формулы вновь работают
Ввод формул работает при наборе текста а не числовых значений (как условие)
Сделано для того чтоб не плодить в большом массиве данных формулы (иначе тормозит таблица при пересчете ячеек) а добавлять формулы в требуемые ячейки при появлении исх данных


Проблема следующая:
Если текст в исх ячейках С11 С12 С13 и тд появляются не ручным вводом текста а по формуле ссылки - я путем "перетаскиванием" формулы по столбцу ввожу ссылки в нижние ячейки столбца С
(ТО ЕСТЬ ЗАНОШУ ЗНАЧЕНИЯ СРАЗУ ОДНОВРЕМЕННО В НЕСКОЛЬКО ЯЧЕЕК СТОЛЦА) то то пересчет формул не ведется

Пересчет ведется когда только по одной дополн записи в колонку С добавляешь

Посоветовали в код макроса добавить принудительный пересчет формул:
Application.Volatile
но данный вариант чегото не сработал

Код от R Dmitry (спасибо автору !)

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row = 11 Then Exit Sub 'строка начала диапазона текста(задаем диапазон текста)
If Target.Column = 3 Then ' столбец начала диапазона текста(задаем диапазон текста)
Debug.Print Target.Value
Range(Cells(Target.Row, 7), Cells(Target.Row, 9)) _
= [g11:i11].Formula ' диапазон столбцов+диапазон исх ячеек с формулами
If Target.Value = "" Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание
If IsNumeric(Target.Value) Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание
End If
End Sub

Как это можно поправить ?

Файл прилагаю

[Djeki]

Попробуйте вот так

ActiveSheet.Calculate

[Uralmaster]

не помогает чтото ...

[Uralmaster]

Также иногда ошибки вылазят типа
=INDIRECT("'" & ROW()-10 & "'!E3") вместо значения по формуле =ДВССЫЛ("'" & СТРОКА()-10 & "'!E3")
=INDIRECT("Контакты!E" & ROW()-7) вместо значения по формуле =ДВССЫЛ("Контакты!E" & СТРОКА()-7)
при копировании макросом

При обычном копировании без макроса таких ошибок нет

Чего-то никто не отвечает ...

[Uralmaster]

Все поправил вроде работает

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next 'по ошибке перейти к выполнению следующей строки
    Application.ScreenUpdating = False 'чтоб не моргало
    Debug.Print Target.Address
    Application.EnableEvents = False
    For Each ch In Target
    If Not Application.Intersect(ch, Range("C11:C4003")) Is Nothing Then
    Range(Cells(ch.Row, 7), Cells(ch.Row, 9)) _
    = [g11:j11].Formula ' диапазон столбцов+диапазон исх ячеек с формулами
    If ch.Value = "" Then Range(Cells(ch.Row, 7), Cells(ch.Row, 9)).ClearContents 'защита на стирание
    If IsNumeric(ch.Value) Then Range(Cells(ch.Row, 7), Cells(ch.Row, 9)).ClearContents  'защита на стирание
    [A10:J4004].WrapText = True   'переносим по словам
    [A10:J4004].EntireRow.AutoFit 'подбираем высоту
    End If
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True 'включаем ScreenUpdating

End Sub