Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

9th
Сен

Изменение ячеек при копировании

Posted by Chas under Basic, Пост-обзор

Столкнулась с такой проблемой. Для расчета различных цен и скидок необходимо было прописать зависимости значений одних ячеек от других, например, если заполнена такая и такая колонка, то такую-то цену считаем так-то, а если такая-то колонка не заполнена — цену пересчитываем по другому. Код реализовала на событие листа Change

EducatedFool
Если уж так нужен макрос — то выглядеть он должен как-то так:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' пересечение изменённого диапазона с интересующим нас диапазоном

    Dim ra As Range, cell As Range: Set ra = Intersect(Target, [g16:g515])
    If ra Is Nothing Then Exit Sub    ' интересующие нас ячейки не были изменены - выходим из макроса
    On Error Resume Next

    Application.EnableEvents = False    ' временно отключаем сработку событий листа
    For Each cell In ra.Cells    '  перебираем изменённые ячейки
        With cell    ' вычисления над очередной изменённой ячейкой

            If ((.Offset(0, 3) = 0) And (.Offset(0, 2) = 0) And (.Offset(0, 5) = 0) And (.Offset(0, 6) = 0)) Then

                totalsell = 1

                .Offset(0, 1) = .Offset(0, 0) * .Offset(0, -4)

            End If
            If (.Offset(0, 3) <> 0) Then

                totalsell = 1

                Add = 1

                .Offset(0, 2) = ((.Offset(0, 0) / .Offset(0, 3)) - 1) * 100

                .Offset(0, 1) = .Offset(0, 0) * .Offset(0, -4)

            End If

            totalsell = 0

            Add = 0

        End With

    Next cell
    Application.EnableEvents = True    ' включаем обратно сработку событий листа

End Sub