Установка значения ячейки Excel на основе другого значения ячейки с использованием VBA - PullRequest
0 голосов
/ 11 декабря 2018

У меня есть следующая таблица.Когда в ячейке BI присутствует x, необходимо заполнить ячейки d и e в одной строке, используя уравнение, которое у меня есть.если в ячейке b нет x, мне нужно вручную ввести значения в ячейки d & e.

enter image description here

Как сделать мой код не специфичным для строки?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim val As String
    val = Range("B3").Value
    If val = "x" Then
        Range("E3").Value = Range("d2").Value * Range("G2").Value
        Range("D3").Value = Range("D2").Value
    End If
End Sub

Ответы [ 3 ]

0 голосов
/ 11 декабря 2018

Вы создали подпроцедуру вокруг события Worksheet_SelectionChange.Фактически вам требуется Worksheet_Change, и вам необходимо

  • отключить обработку событий, чтобы вы могли записывать новые значения / формулы на лист, не запуская Worksheet_Change поверх самого себя.
  • циклчерез каждую соответствующую ячейку в Target, чтобы компенсировать обстоятельства, когда Target может быть больше, чем одна ячейка,
  • добавить контроль ошибок.

Переписать:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Range("B:B"))
            If LCase(t.Value) = "x" Then
                'I've made these formulas relative to each target
                'you may want to make some absolute references
                t.Offset(0, 3) = t.Offset(-1, 2) * t.Offset(-1, 5)
                t.Offset(0, 2) = t.Offset(-1, 2)
            Else
                t.Offset(0, 2).resize(1, 2) = vbnullstring
            End If
        Next t
    End If

safe_exit:
    Application.EnableEvents = True

End Sub
0 голосов
/ 11 декабря 2018

Пожалуйста, попробуйте ниже код.Он перебирает все непустые строки в столбце B и проверяет, есть ли значение: x Если да, он заполняет ваши формулы.

Sub new_sub()
 ' get last_row of data
last_row = ActiveSheet.UsedRange.Rows.Count

' loop through all rows with data and check if in column B any cell contains value: x
For i = 1 To last_row
    ' if there is any cell with value: x
    ' then add below formulas
    If Cells(i, 2).Value = "x" Then
        ' for column E: take value from row above for col D and G and multiple
        Range("E" & i).Value = Range("d" & i - 1).Value * Range("G" & i - 1).Value
        ' for column D: take value from row above
        Range("D" & i).Value = Range("D" & i - 1).Value
    End If
Next i

End Sub
0 голосов
/ 11 декабря 2018

Я не уверен, правильно ли я понимаю, но если у вас есть параметр: row = 3, вы можете использовать Range ("E" и row) вместо Range ("E3").

Putцикл вокруг того, где вы меняете 'row' для строк, которые вы хотите изменить.

Надеюсь, это поможет!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...