Может ли код VBA изменить содержимое ячейки после ввода? - PullRequest
1 голос
/ 21 октября 2019

Мне нужен код VBA, который будет умножать содержимое ячейки на содержимое другой ячейки при вводе ввода.

Например, у меня 75% в ячейке B1. Когда я ввожу 25 000 в ячейку C1, я хочу, чтобы 25,00 автоматически умножались на 75% в B1, чтобы в ячейке было 18 750. Какой самый простой код, который сделает это? Я не кодер, но использовал модификатор события и диапазон - и он работал один раз!

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C1:F1")) Is Nothing Then
    Application.EnableEvents = False
    Target.Value = Target.Value * Range("B1").Value
Application.EnableEvents = True
End If
End Sub

Я запустил его в первый раз, но он должен работать непрерывно, так как я используютаблицы.

Ответы [ 3 ]

2 голосов
/ 21 октября 2019

Должно выглядеть примерно так:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range

    Set rng = Application.Intersect(Target, Me.Range("C1:F1"))'range of interest

    'any cells affected?
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        'loop over affected cells
        For each c in rng.cells
            c.Value = c.Value * Me.Range("B1").Value
        Next c
        Application.EnableEvents = True
    End If

End Sub
1 голос
/ 21 октября 2019

Я бы добавил несколько проверок перед запуском реального кода. Проверки следующие:

If Target.Cells.Count > 1 Then Exit Sub - отключить код при добавлении 2 ячеек одновременно. Очень полезно, когда удаляются несколько ячеек.

If Not IsNumeric(Target.Cells(1)) Then Exit Sub - убедитесь, что введенное значение является числовым

If Not IsNumeric(Range("B1")) Then Exit Sub - убедитесь, что значение, на которое умножаетсяявляется числовым

Кроме того, хорошей идеей является определение multiplier в виде десятичной дроби, чтобы избежать некоторых проблем с плавающей запятой, которые могут возникнуть ( (10 * 1.11 = 11.1) оценивается как FALSE. исправить это? ).

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Not IsNumeric(Target.Cells(1)) Then Exit Sub
    If Not IsNumeric(Range("B1")) Then Exit Sub

    Dim multiplier As Variant
    multiplier = CDec(Range("B1"))

    If Not Intersect(Target, Range("C1:F1")) Is Nothing Then
        Application.EnableEvents = False
        Target.Value = Target.Value * multiplier
        Application.EnableEvents = True
    End If

End Sub
1 голос
/ 21 октября 2019

Обратная логика:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C1:F1")) Is Nothing Then
        Application.EnableEvents = False
            Target.Value = Target.Value * Range("B1").Value
        Application.EnableEvents = True
    End If
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...