Триггер, который обновит ячейки в столбце с одинаковым значением

Question

Я пытаюсь написать макрос, который обновит все ячейки в столбце, которые имеют то же значение, что и соседний столбец ниже, до и после того, что я пытаюсь выполнить.В этом примере вы обновите B1, а затем все ячейки в A1 с тем же значением обновятся до значения B1

Вот код, который я использую

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng1 As Range
Dim cel As Range

Set rng1 = Range("A1", Range("A2").End(xlDown))

For Each cel In rng1
    If cel = Target.Offset(0, -1).Value Then
    cel.Offset(0, 1).Value = Target.Value
    End If
Next cel

End Sub

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

Answer 1

Я бы постарался избежать зацикливания, если это возможно.Возможно, вместо этого используйте UDF, используя метод .Find()?

Option Explicit

Function myLookup(ByVal rng As Range) As String

    Application.Volatile

    Dim ws As Worksheet, lookupRng As Range, retRng As Range
    Set ws = rng.Parent
    With ws
        Set lookupRng = .Range(.Cells(1, rng.Column), .Cells(rng.Row - 1, rng.Column))
    End With

    Set retRng = lookupRng.Find(rng.Value, ws.Cells(1, rng.Column))
    If retRng Is Nothing Then
        myLookup = vbNullString
    Else
        With retRng
            myLookup = ws.Cells(.Row, .Column + 1)
        End With
    End If

End Function

Вы бы поместили этот UDF в таблицу следующим образом:

и заполните.Это предотвратит циклические ссылки, потому что будет искать ячейки над ним только в пределах lookupRng.

И конечный результат:

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 2 Then Exit Sub

Application.ScreenUpdating = False
    For Each cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If cel = Target.Offset(, -1) Then
            cel.Offset(, 1) = Target
        End If
    Next cel
Application.ScreenUpdating = True

End Sub