Макрос работа по условию изменения значения по ссылке

[Uralmaster]

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


Проблема следующая:
Если текст в исх ячейках С12 С13 С14 и тд появляются, стирается или изменяется не ручным вводом текста а по формуле ссылки из другого листа - то то пересчет формул не ведется

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

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:i11].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

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

[Hugo121]

Может что-то вроде...?
Не доделал - формулу не протягивает, но сигнализирует!

[Uralmaster]

Видимо надо сначала проверить при отрытии листа в макросе какие ячейки в столбце С (исх значения) имеют текст а потом "протянуть" на них одну верхнюю ячейку как вариант - хотя если каждый раз заново проверять и старые и новые ячейки с текстом и накладывать на них макрос небыстро будет в большом массиве ...
Так сделать если
Range("C11").Select
Selection.AutoFill Destination:=Range("C11:C3993"), Type:=xlFillDefault
Range("C11:C3993").Select
Range("C11").Select
?? куда и как вставить?

[Uralmaster]

если коротко нужна привязка к исходному листу "Список";

в листе где прописан макрос (лист "Сводный лист") значения в столбце С формируются за счет формул типа =список!B8 и тд с листа "Список"

Условия:
1.Если исходные значения в листе "Список" в столбце В появляются в текстовом формате -
на листе "Сводный лист" в соответствующих ячейках в столбце С появляется тотже текст и в соответствующих строках на этом листе G12:I12 (и вниз) считаются формулы по образцу G11:I11
Если короче: В "Списке" столбец B появляется (или имеется текст !!) - срабатывают формулы на листе "Сводный лист"

2.В "Списке" столбец B удалили текст - удаляются формулы на листе "Сводный лист"

3.В "Списке" столбец B изменили текст - пересчитываются соотв формулы на листе "Сводный лист"

Вот так надо

А сейчас этого не происходит - по ссылкам со "Список" мертво .... Действия только тогда происходят когда на самом листе "Сводный лист"значения меняешь в столбце С(не по ссылкам)....

Может из-за формул ссылок макрос текст не видит ??
Как то было при макросе поиска тоже не видел текст, формируемый ссылками с другого листа

Public Sub Searsh()
    Cells.Find(What:=[C4], After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
End Sub

не работал по ссылкам изменили на

Public Sub Searsh()
    Cells.Find(What:=[C4], After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
End Sub

то есть LookIn:=xlFormulas поменяли на LookIn:=xlValues
и заработало - макрос текст стал видеть

[Hugo121]

Что-то мне подсказывает, что мой пример Вы не смотрели. Может быть смотрели, но не поняли?

[Uralmaster]

смотрел конечно - но как заставить макрос найти измененное значение на сводном листе и протянуть верхнюю ячейку на измененное значение не знаю ...

[Hugo121]

Так:

Private Sub Worksheet_Calculate()
Dim i As Long
b = Range("C11:C4003").Value
For i = 1 To UBound(a)
If a(i, 1) <> b(i, 1) Then MsgBox "Пора формулу протянуть!" & vbNewLine & "Изменилась строка " & i
Next
End Sub

Применительно к листу - прибавьте 10.

[Uralmaster]

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

[Uralmaster]

Sub Макрос1()
'макрос протягивает формулу с ячейки I10 до ячейки с общим объёмом
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 9).End(xlUp).Row - 1
Range(Cells(10, 9), Cells(iLastRow, 9)).FillDown
End Sub

[Hugo121]

Поясню про i и 10 - в мессидже выкидывает значение i, которое совпадает с номером строки анализирумой таблицы (того, что берём в массив), но отличается от номера строки листа на 10.
Т.е. если Вы хотите использовать это значение в протягивании или заполнении формулой - используйте i+10.
И я думаю, что не нужно протягивать, нужно заполнять по одной ячейке - т.к. пересчёт сработает после ручного ввода в каждую ячейку. И например если изменят где-то внизу - то зачем Вам формулы с верха до низа, если работать будут например только две? Конкретно в эти ячейки их и ставить - где изменилось.
Но вот как будет, если закопипастить сразу несколько значений - это нужно ещё подумать, как сделать...
И кстати при сравнении массивов и тип данных можно проанализировать - текст, число, дата.