是否有任何代码可以标识一个特定的单元格(b2),然后将公式代入另一个单元格(i2)?

时间:2019-02-09 07:29:38

标签: excel vba excel-formula

the yellow highighted is where the data is entered 让我们说单元格b2是数据输入..而i2到AD2是其中要设置公式的单元格。

我需要一个vba代码来标识b2 =任何金额/符号(如果为true),如果公式[[IF($ I $ 1 = D2,G2,“”)]

这应该应用于所有行

1 个答案:

答案 0 :(得分: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)复制到该范围的其余部分,则该公式将像您将其插入到范围中一样。假设您想要这样,我对公式做了一些更改。

通过以下操作,您只能获得更改后的行,即i。 e。如果粘贴到e。 G。 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