Доброго времени суток уважаемые форумчане!!!!! Нуждаюсь в вашей помощи. Есть у меня таблица, в которой работают немножко рукож.... юзвери. Табличка на формулах, которые постоянно данными индивидуумами уничтожаются. Вследствии чего случаются ошибки в планировании, что недопустимо. Вопрос такой. В этой таблице задается количество комплектов деталей в производство. Эти комплекты расписываются подетально. в столбце Е ставится количество деталей на комплект. Необходимо, что бы при проставлении количества комплектов в таблице ( выделено желтым для примера) проставлялось количество деталей в этом комплекте. P.S То есть надо считать только в тех строках, где в столбце Е стоит число.
Доброго времени суток уважаемые форумчане!!!!! Нуждаюсь в вашей помощи. Есть у меня таблица, в которой работают немножко рукож.... юзвери. Табличка на формулах, которые постоянно данными индивидуумами уничтожаются. Вследствии чего случаются ошибки в планировании, что недопустимо. Вопрос такой. В этой таблице задается количество комплектов деталей в производство. Эти комплекты расписываются подетально. в столбце Е ставится количество деталей на комплект. Необходимо, что бы при проставлении количества комплектов в таблице ( выделено желтым для примера) проставлялось количество деталей в этом комплекте. P.S То есть надо считать только в тех строках, где в столбце Е стоит число.китин
Миша привет!желтые там где пустая ячейка в столбце Е. в реальном файле они не покрашены, это я для примера[p.s.] у меня там в модуле листа мои жалкие попытки
Миша привет!желтые там где пустая ячейка в столбце Е. в реальном файле они не покрашены, это я для примера[p.s.] у меня там в модуле листа мои жалкие попыткикитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Сообщение отредактировал китин - Среда, 24.05.2017, 09:19
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr&, lc&, r&, nextRow As Range lr = Cells(Rows.Count, 3).End(xlUp).Row lc = Cells(13, Columns.Count).End(xlToLeft).Column - 3
'Если в изменяемом диапазоне больше 1 ячейки, выходим из макроса If Target.Count > 1 Then Exit Sub 'Если изменяем за пределами табицы (в примере F13:R70), выходим из макроса If Intersect(Target, Range("f13", Cells(lr, lc))) Is Nothing Then Exit Sub
'Отключаем обработку событи Application.EnableEvents = False 'Запоминаем номер следующей строки в r r = Target.Row + 1 'Если ячейка в этой же строке в столбце е = "" и следующая ячейка в столбце е <>"" If Cells(Target.Row, "e") = "" And Cells(r, "e") <> "" Then 'Ищем следующую пустую ячейку в солбце е (она нам нужна, 'чтобы высчитать диапазон, в котором будем умножать кол-во деталей на кол-во комплектов) '+1 в Range("e" & r, "e" & lr + 1) нужен для того, чтобы для последнего чертежа (строка 68) 'получить корректный диапазон Set nextRow = Range("e" & r, "e" & lr + 1).Find(What:="", After:=Range("e" & r)) 'если нашли If Not nextRow Is Nothing Then 'идем по диапазону для текущего чертежа (в примере ячейки между желтыми линиями) For Each cell In Target.Offset(1).Resize(nextRow.Row - r) 'записываем в каждую ячейку кол-во деталей (столбец е) * кол-во комплектов (наша желтая ячейка) cell.Value = Cells(cell.Row, "e").Value * Target.Value Next cell End If End If Application.EnableEvents = True End Sub
[/vba]
Игорь, привет. Так нужно? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr&, lc&, r&, nextRow As Range lr = Cells(Rows.Count, 3).End(xlUp).Row lc = Cells(13, Columns.Count).End(xlToLeft).Column - 3
'Если в изменяемом диапазоне больше 1 ячейки, выходим из макроса If Target.Count > 1 Then Exit Sub 'Если изменяем за пределами табицы (в примере F13:R70), выходим из макроса If Intersect(Target, Range("f13", Cells(lr, lc))) Is Nothing Then Exit Sub
'Отключаем обработку событи Application.EnableEvents = False 'Запоминаем номер следующей строки в r r = Target.Row + 1 'Если ячейка в этой же строке в столбце е = "" и следующая ячейка в столбце е <>"" If Cells(Target.Row, "e") = "" And Cells(r, "e") <> "" Then 'Ищем следующую пустую ячейку в солбце е (она нам нужна, 'чтобы высчитать диапазон, в котором будем умножать кол-во деталей на кол-во комплектов) '+1 в Range("e" & r, "e" & lr + 1) нужен для того, чтобы для последнего чертежа (строка 68) 'получить корректный диапазон Set nextRow = Range("e" & r, "e" & lr + 1).Find(What:="", After:=Range("e" & r)) 'если нашли If Not nextRow Is Nothing Then 'идем по диапазону для текущего чертежа (в примере ячейки между желтыми линиями) For Each cell In Target.Offset(1).Resize(nextRow.Row - r) 'записываем в каждую ячейку кол-во деталей (столбец е) * кол-во комплектов (наша желтая ячейка) cell.Value = Cells(cell.Row, "e").Value * Target.Value Next cell End If End If Application.EnableEvents = True End Sub