Страницы: 1
RSS
[VBA] Расчет значения ячейки при изменении соседней ячейки
 
Добрый день.
У меня такая проблема:
Есть формула "=ЕСЛИ((N2-B2)<0;0;ЕСЛИ((N2-B2)>1;(((N2-B2)*1440)-(ЦЕЛОЕ(N2-B2)*1440*6.5/24));(N2-B2)*1440)) ", которая должна рассчитывать значение при изменении соседней ячейки. Причем если строка изменится то соответственно должны измениться адреса ячеек (например в 3-ей строке должно быть N3-B3 ну и т.д.) Попробовал сделать макрос:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("C2:C10000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(0, -2)         'вводим в соседнюю справа ячейку дату
                .Formula = IIf(Intersect(cell, Range("C2:C10000")) < 0, 0, IIf(Intersect(cell, Range("C2:C10000")) > 1, "=((D2)*1440)-(INT(D2)*1440*6.5/24)", "=(D2)*1440"))
                .Calculate
                .Value = .Value
                .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
Next cell
End Sub
Есть две проблемы:
1) В условии функции IIf не могу сделать разницу двух значений VBA начинает на меня "ругаться". А именно хочу записать в условии что-то в виде IIf(Intersect(cell, Range("C2:C10000")) - Intersect(cell, Range("D2:D10000")).....".
2) В формулах (там где "истина" или "ложь") не могу сделать так чтобы не было "жесткой" привязки к ячейке, т.е. чтобы работало автозаполнение.....

С уважением.
Изменено: BigPluxoV - 28.10.2019 09:17:36
 
попробуйте так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target   'проходим по всем измененным ячейкам запись даты регистрации
       If Not Intersect(cell, Range("C2:C10000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(, -2)         'вводим в соседнюю справа ячейку дату
                Application.EnableEvents = False ' откл. отслеж. событий
                If Intersect(cell, Range("C2:C10000")) < 0 Then
                    .Value = 0
                Else
                    If Intersect(cell, Range("C2:C10000")) > 1 Then
                        .Value = .Offset(, 3) * 1440 - (Int(.Offset(, 2) - .Offset(, 1)) * 1440 * 6.5 / 24)
                    Else
                        .Value = .Offset(, 3) * 1440
                    End If
                End If
'                .Formula = IIf(Intersect(cell, Range("C2:C10000")) < 0, 0, IIf(Intersect(cell, Range("C2:C10000")) > 1,
'                "=(D2)*1440)-(INT(C2-B2)*1440*6.5/24)", "=(D2)*1440"))
'                .Calculate
'                .Value = .Value
                Application.EnableEvents = True ' вкл. отслеж. событий
                .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
Next cell
End Sub
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Спасибо!
 
Поколдовал над кодом еще немного и вот готовый вариант
Код
For Each cell In Target   'проходим по всем измененным ячейкам запись даты регистрации
       If Not Intersect(cell, Range("N2:N10000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(, 5)         'вводим в соседнюю справа ячейку дату
                If Intersect(cell, Range("N2:N10000")) <= 0 Then
                    .Value = 0
                Else
                     .Value = (.Offset(, -5) - .Offset(, -17))
                     .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
                End If
            End With
       End If
 Next cell
For Each cell In Target   'проходим по всем измененным ячейкам запись даты регистрации
       If Not Intersect(cell, Range("S2:S10000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
            With cell.Offset(, -4)         'вводим в соседнюю справа ячейку дату
                Application.EnableEvents = False ' откл. отслеж. событий
                If Intersect(cell, Range("S2:S10000")) <= 0 Then
                    .Value = 0
                Else
                    If Intersect(cell, Range("S2:S10000")) >= 1 Then
                        .Value = (.Offset(, -1) - .Offset(, -13)) * 1440 - (Int(.Offset(, -1) - .Offset(, -13)) * 1440 * 6.5 / 24)
                    Else
                        .Value = (.Offset(, -1) - .Offset(, -13)) * 1440
                    End If
                End If
                Application.EnableEvents = True ' вкл. отслеж. событий
                .EntireColumn.AutoFit  'выполняем автоподбор ширины для столбца B, чтобы дата умещалась в ячейке
            End With
       End If
 Next cell
End Sub
Страницы: 1
Наверх