Добрый день. У меня такая проблема: Есть формула "=ЕСЛИ((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) В формулах (там где "истина" или "ложь") не могу сделать так чтобы не было "жесткой" привязки к ячейке, т.е. чтобы работало автозаполнение.....
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