Изменить значение столбцов на основе другой ячейки - PullRequest
0 голосов
/ 30 октября 2019

Я хочу обновить значения 2 столбцов, основываясь на другом значении столбцов (при изменении значения). Предположим, у меня есть столбец A со списком (AA1, AA2, AA3), столбец B со списком (BB1, BB2), столбец C со списком (CC1, CC2). Если выбрать значение «AA1» из столбца A, тогда значение столбца B должно измениться на BB2, а столбец C - на CC1. Но ничего не должно произойти, если значение, выбранное в столбце A, отличается от «AA1». Тот же процесс происходит и для значения «BB1» в столбце B. Я добавил vba, но он не работает. Также есть ли другой способ сделать это без запуска кода VBA? Спасибо

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim changedCells As Range
   Set changedCells = Range("A:C")

   If Not Application.Intersect(changedCells, Range(Target.Address)) Is Nothing Then

      If Target.Count > 1 Then Exit Sub

      If Target.Column = 1 And LCase(Target.Value) = "aa1"Then
            Cells(Target.Row, 2) = "BB2"
            Cells(Target.Row, 3) = "CC1"
      ElseIf Target.Column = 2 And LCase(Target.Value) = "bb1" Then
           Cells(Target.Row, 1) = "AA3"
           Cells(Target.Row, 3) = "CC2"
       ElseIf Target.Column = 3 And LCase(Target.Value) = "cc2" Then
           Cells(Target.Row, 1) = "AA2"
           Cells(Target.Row, 2) = "BB2"
        End If
 End If
End Sub

1 Ответ

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

Ваш код в целом в порядке, за исключением того, что он вызовет каскад событий (изменение ячейки вызывает событие Worksheet_Change, которое меняет ячейку, которая вызывает Worksheet_Change, что ...)

Вынеобходимо добавить Application.EnableEvents = False, чтобы предотвратить это (добавьте ... = True в конце)

Вот ваш код с рефакторингом для решения этой проблемы, а также несколько других незначительных проблем

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedCells As Range

    On Error GoTo EH '~~ ensure EnableEvents is turned back on if an error occurs

    Set changedCells = Me.Range("A:C") '~~ explicitly refer to the correct sheet

    If Target.Count > 1 Then Exit Sub '~~ do this first, to speed things up

    If Not Application.Intersect(changedCells, Target) Is Nothing Then '~~ Target is already a range
        Application.EnableEvents = False '~~ prevent an event cascade

        '~~ original If Then Else works fine.  But can be simplified
        Select Case LCase(Target.Value)
            Case "aa1"
                If Target.Column = 1 Then
                    Me.Cells(Target.Row, 2) = "BB2"
                    Me.Cells(Target.Row, 3) = "CC1"
                End If
            Case "bb1"
                If Target.Column = 2 Then
                    Me.Cells(Target.Row, 1) = "AA3"
                    Me.Cells(Target.Row, 3) = "CC2"
                End If
            Case "cc2"
                If Target.Column = 3 Then
                    Me.Cells(Target.Row, 1) = "AA2"
                    Me.Cells(Target.Row, 2) = "BB2"
                End If
        End Select
    End If

'~~ Fall through to EnableEvents
EH:
    Application.EnableEvents = True '~~ ensure EnableEvents is turned back on
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...