есть ли код, который идентифицирует конкретную ячейку (b2) и затем подставляет формулу в другую ячейку (i2)?

Question

выделено желтым цветом, где вводятся данные допустим, что ячейка b2 является вводом данных ... и от i2 до AD2 - это ячейки, в которых предполагается задавать формулы.

iнужен код vba, который идентифицирует b2 = любое количество / символ, если оно истинно, от I2 до ad2 следует вставить это, если формула [[IF ($ I $ 1 = D2, G2, "")]

Это должно быть примененово всех рядах

Answer 1

Пожалуйста, поместите это в модуль рабочего листа .

Он проверяет, была ли ячейка B2 изменена и содержит что-то, а затем помещает формулу во весь диапазон, начиная с I2:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RelevantArea As Range
    Dim lastRow As Long

    Set RelevantArea = Intersect(Target, Me.Range("B2"))
    If Not RelevantArea Is Nothing Then
        If Len(Target.Value2) > 0 Then
            ' find the last used row, e. g. in column 9:
            lastRow = Me.Cells(Me.Rows.Count, 9).End(xlUp).Row
            Application.EnableEvents = False
            Me.Range("I2:AD" & lastRow).Formula = "=IF(I$1=$D2,$G2,"""")"
            Application.EnableEvents = True
        End If
    End If
End Sub

Формула вставляется в диапазон, как если бы вы ее получали, если скопировать формулу первой ячейки (здесь: I2) в остальную часть диапазона.Я немного изменил формулу, предполагая, что вы хотите, чтобы это было так.

Следуя вам, вы получите его только для измененной строки, т.е. если вы вставите, например, в B5: B9, это будет работать для строк с 5 по 9.
Вы можете использовать нотацию A1 или R1C1 для адаптации формулы к вашим потребностям.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MonitoredArea As Range
    Dim CurrentRow As Long
    Dim CurrentCell As Range

    Set MonitoredArea = Intersect(Target, Me.Range("B:B"))
    If Not MonitoredArea Is Nothing Then
        For Each CurrentCell In MonitoredArea.Cells
            If Len(CurrentCell.Value2) > 0 Then
                CurrentRow = CurrentCell.Row
                Application.EnableEvents = False
                With Me.Range(Me.Cells(CurrentRow, "I"), Me.Cells(CurrentRow, "AD"))
                    .Formula = "=IF(I$1=$D" & CurrentRow & ",$G" & CurrentRow & ","""")"
                    '.FormulaR1C1 = "=IF(R1C=RC4,RC7,"""")"

                    Dim i As Integer
                    For i = xlEdgeLeft To xlInsideHorizontal  ' all borders
                        With .Borders(i)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .Color = RGB(0, 0, 0)
                            .TintAndShade = 0
                        End With
                    Next i

                End With
                Application.EnableEvents = True
            End If
        Next CurrentCell
    End If
End Sub