Страницы: 1
RSS
Пересчет при изменение в ячейки (VBA)
 
Добрый день.  
Имеется код (Из раздела Приемы)  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
       If Not Intersect(Target, Range("A2:A100")) Is Nothing Then  
           With Target(1, 2)  
               .Value = Now  
               .EntireColumn.AutoFit  
           End With  
       End If  
End Sub  
 
При изменение ячейки A2:A100 в B2:B100 вносится дата изменения, а как быть, если ячейка ссылается на другую. Предположим A2=$C$3, A3=$C$3 и при изменение ячейки C3 измения не будут происходить.  
Спасибо
 
Есть такая мысль - взять эти значения в публичный массив (при загрузке книги), и потом при изменении в диапазоне и связанных (precedents) ячейках сравнивать предыдущий и текущий массивы. По результату действовать, обновить предыдщий массив.
 
{quote}{login=Hugo}{date=08.06.2011 06:09}{thema=}{post}Есть такая мысль - взять эти значения в публичный массив (при загрузке книги), и потом при изменении в диапазоне и связанных (precedents) ячейках сравнивать предыдущий и текущий массивы. По результату действовать, обновить предыдщий массив.{/post}{/quote}  
А как будет в виде кода?  
Не силен в VBA (практически 0). Пытаюсь на примерах что-то соорудить (в частности на показанном выше)  
Спасибо
 
Что-то вроде... Код в трёх местах :)
 
Большое спасибо
 
Немного не выходит, может я не так объяснил.  
Вся строчка ссылается на 1 число и при смени 1 числа надо чтобы был пересчет (вносило в той же строке напротив дату). Во вложение я показал как хочется чтобы было.  
Спасибо
 
Да, не сумели творчески переработать месиджбокс...  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
   Dim b, i&  
   If Not Intersect(Target, Range("A2:A100")) Is Nothing Or Not Intersect(Target, Range("A2:A100").Precedents) Is Nothing Then  
       b = Sheets(1).[a2:a100].Value
       For i = 1 To UBound(b)  
           If a(i, 1) <> b(i, 1) Then  
               With Cells(i + 1, 2)  
                   .Value = Now  
                   .EntireColumn.AutoFit  
               End With  
               End If  
           Next  
       a = b  
       End If  
End Sub  
 
И ещё - этот код не отслеживает изменение формул, а только значения. Т.е. если вместо =C3 будет написано =C3+D3, но результат не изменится - то код не прореагирует.  
И зря Вы в примере все формулы забили на одну ячейку...
 
{quote}{login=Hugo}{date=08.06.2011 09:51}{thema=}{post}Да, не сумели творчески переработать месиджбокс...  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
   Dim b, i&  
   If Not Intersect(Target, Range("A2:A100")) Is Nothing Or Not Intersect(Target, Range("A2:A100").Precedents) Is Nothing Then  
       b = Sheets(1).[a2:a100].Value
       For i = 1 To UBound(b)  
           If a(i, 1) <> b(i, 1) Then  
               With Cells(i + 1, 2)  
                   .Value = Now  
                   .EntireColumn.AutoFit  
               End With  
               End If  
           Next  
       a = b  
       End If  
End Sub  
 
И ещё - этот код не отслеживает изменение формул, а только значения. Т.е. если вместо =C3 будет написано =C3+D3, но результат не изменится - то код не прореагирует.  
И зря Вы в примере все формулы забили на одну ячейку...{/post}{/quote}  
 
люди добрыяяя) подскажите, переменная Variant в данном случае  
 
b = Sheets(1).[a2:a100].Value
 
может указывать только на значения? Или, к примеру, на цвет ячейки?
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
 
На мой взгляд только значения. Но я не добрый.
 
{quote}{login=Юрий М}{date=08.06.2011 10:54}{thema=}{post}На мой взгляд только значения. Но я не добрый.{/post}{/quote}  
 
Благодарю! Вы на себя наговариваете ; )  
 
Да, Вы абсолютно правы. "Переменная Variant может принимать значения любого из простых типов". Объект к коим не относиться. А цвет - это свойство объекта...
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
 
Большое спасибо за помощь, но попытался приблизить данный пример к своей задачи, но так и не вышло.  
Необходимо сделать в VBA формулу C8:C13 и чтобы при изменении ячейки A3 (Соответственно для каждой строки меняется значение в строке D8:D13) делался пересчет C8:C13 в VBA.  
Надеюсь понятно объяснил.  
 
Еще вопрос, возможно ли вместо b = Sheets(1).[D8:D13].Value вписать вместо [D8:D13] - Range("название региона") и вместо Sheets("Sheet1") ?
Еще вписал значение: Set rng1 = Range("rng1") - это правильно?  
 
Спасибо
 
Вот пиии ... Ошибся темой. Как удалить? Извините.
 
Разве ошиблись?  
Почти правильно:  
 
 
Private Sub Worksheet_Change(ByVal Target As Range)  
 
   If Target.Cells.Count > 1 Then Exit Sub  
   Dim b, i&  
     
     
   If Not Intersect(Target, [rng1]) Is Nothing Or Not Intersect(Target, [rng1].Precedents) Is Nothing Then
       b = Sheets(1).[D8:D13].Value
       For i = 1 To UBound(b)  
           If a(i, 1) <> b(i, 1) Then  
               With Cells(i + 1, 2)  
                 
                   .Value = "?????"  
                     
               End With  
               End If  
           Next  
       a = b  
       End If  
End Sub  
 
Вот только я не понял, куда вопросы планировалось ставить?  
В строке Cells(i + 1, 2) значение i+2 нужно вписать относительно того, какой диапазон берётся в массивы. В первом примере брался с А2, поэтому было +1, тут вероятно нужно With Cells(i + 7, 5)
 
Работает даже так, ещё короче код с именованным диапазоном:  
 
 
Private Sub Workbook_Open()  
a = [rng1].Value
End Sub  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
   Dim b, i&  
 
   If Not Intersect(Target, [rng1]) Is Nothing Or Not Intersect(Target, [rng1].Precedents) Is Nothing Then
       b = [rng1].Value
       For i = 1 To UBound(b)  
           If a(i, 1) <> b(i, 1) Then  
               With Cells(i + 7, 5)  
 
                   .Value = "?????"  
 
               End With  
           End If  
       Next  
       a = b  
   End If  
End Sub
 
Вместо вопросов должна быть формула из ячейки C8 т.е. должно быть умножение ячеек "=B8*D8" в ячейки C8, в ячейки C9 - "=B9*D9" и это все должно меняться при изменение диапазона D9:D13.
 
А нельзя вместо Cells(i + 7, 5) сделать как было в первом примере через    
With Target(1, 2)  
     .Value = Now  
     .EntireColumn.AutoFit  
End With    
Не нравится, что необходимо отсчитывать количество ячеек, а если в будущем что-то поменяется, то будет необходимость опять пересчитывать. Или можно как-то привязвать к определенному региону?  
Спасибо
 
Ну тут у Вас Targetом будут и [rng1].Precedents, так что к таргету привязываться нельзя.
Но эато в этом конкретном случае можно так:  
 
               With [rng1].Offset(, 1)
                   .Value = "?????"  
               End With  
 
Раз уж все вопросы одинаковы.  
А вот насчёт формул не понял - Вы хотите формулы менять, или занести?
 
буду завтра пробовать что предложили. на счет формул: мне их надо не вность, а просто сделать умножение. в примере я показал что на что надо умножить для каждой ячейки. предположим: range("b8")*range("d9"). данное умножение надо сделать в коде VBA. естественно будет как-то по другому (через cells может-не силен пока что, надо почитать чего). соответственно вместо вопросительных знаков должно быть умножение ячеек. надеюсь так более понятно?
Страницы: 1
Читают тему
Наверх