使用VBA动态设置公式

Question

左两列（A＆B）不断更新，向每行添加数据，我想为第三列动态生成包含VBA公式的公式。我的想法是，当新行中的某个单元格包含文本时，则其旁边的列单元格（Cx）应该适用于该公式。

例如

B2 = 3

B1 = 2

C2 =（= B2 / B1-B1）

如果B3 = 4，则C3应该应用相同的公式，并且应该动态应用。

你能帮我吗？

Answer 1

我希望我不会对此复杂化，但这是我的尝试。它要更长一些，但是我相信它应该很容易出错，并且性能应该很好。

下面的代码属于工作表的代码（将包含数据的工作表的代码），因此不属于新模块。可以在此处找到示例https://www.excel-easy.com/vba/events.html

我希望它对您有效：-）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)


'target is the cell/range you work with
Dim cell As Range 'the cell is going to be a variable for a single cell,
                  'since if you were working with a range larger than one cell, then this code would crash
                  '(this applies to things like erasing a range of cells)

Dim rng_y As Range 'temporary range that will be filled with the formula
Dim rng_n As Range 'temporary range that will be cleared

Application.ScreenUpdating = False
For Each cell In Target 'Loop through each cell in the range you work with
    If cell.Column < 3 And cell.Row > 1 Then 'this if makes sure you're not going to edit any fileds you don't want to
        If Range("A" & cell.Row).Value <> "" And Range("B" & cell.Row).Value <> "" Then 'make sure to add the formula only to rows that actually contain any data
            If rng_y Is Nothing Then
                Set rng_y = Range("C" & cell.Row) 'this is for the first time when the criteria is met
            Else
                Set rng_y = Union(rng_y, Range("C" & cell.Row)) 'for all the rest ocasions, just joining the already found cells with the new cell
            End If
        Else
            If rng_n Is Nothing Then
                Set rng_n = Range("C" & cell.Row)
            Else
                Set rng_n = Union(rng_n, Range("C" & cell.Row))
            End If
        End If
    End If
Next cell

If Not rng_y Is Nothing Then 'enter formula to cells with the right data
    Application.EnableEvents = False 'disable events of the app, so the loop doens't run again for no reason
    rng_y.Value = "=RC[-2]/RC[-1]-RC[-1]"
    Application.EnableEvents = True 're-enable events, so any future code runs correctly
End If

If Not rng_n Is Nothing Then 'remove formula from empty cells
    Application.EnableEvents = False
    rng_n.Value = ""
    Application.EnableEvents = True
End If


End Sub