Excel 工作表更改 VBA 以更新工作表中的公式范围以更改输入数据

Question

我在 SO 上找到了这个答案，这与我想要做的很接近，但我对 VBA 的了解太基础了，无法针对我的具体情况进行修改。

Automatically copy formulas as data expands

我的情况的不同之处在于我的公式引用的数据不是整个以前的工作表。例如，我希望工作表“B”中的公式使用工作表“A”中的数据，这些数据对应于包含字符串“XYZ”的单元格的那些行。工作表“A”链接到定期更新的数据源，更改包含所述字符串的行数。随着“A”的更新，“B”计算它需要什么，然后自动绘制（我已经有一个子），但我不知道如何自动使公式范围反映数据的波动范围。

有什么想法吗？

Answer 1

基于我认为您正在尝试做的一些合理假设，我编写并测试了以下代码 sn-p（改编自您的链接）。将此添加到工作表 A 的代码中，看看当 A 列中有字符串，工作表 A 的 B 列中有值时它是如何工作的。A 中有“XYZ”的地方，B 列中的值将转移到工作表B，A 列。当您更改工作表 A 上的任何内容时，B 将被更新。

如果这不能帮助您解决问题，您将不得不更清楚地解释缺少的内容...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' when worksheet changes, copy value adjacent to a cell with the string "XYZ" in it
' to worksheet "B", starting in "A1".
' after clearing out everything that was in that range first

    Dim oRangeDest As Range
    Dim oRangeSearch As Range
    Dim searchString As String
    Dim foundCell As Range
    Dim firstFound As String

    'Define output range
    Set oRangeDest = Worksheets("B").Range("A1")
    Set oRangeSearch = Worksheets("A").Range("A:A")

    ' value of string to search for:
    searchString = "XYZ"

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' clear the formulas in sheet B:
    Worksheets("B").Activate
    With ActiveSheet
      .Range(oRangeDest, oRangeDest.End(xlDown)).Select
      Selection.Clear
      .Range("A1").Select
    End With

    Worksheets("A").Activate ' can only search on active sheet

    ' find cells in column A on sheet 1 with "XYZ" in them:
    Set foundCell = oRangeSearch.Find(What:=searchString, _
        After:=ActiveSheet.Cells(1, 1), _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
    If Not foundCell Is Nothing Then
        ' if found, remember location
        firstFound = foundCell.Address
        ' copy the value of the next cell over to the next available cell on sheet B
        Do
            ' copy something from a cell adjacent to the one we found:
            ' obviously we could access a different column, value or formula, etc...
            oRangeDest.Value = foundCell.Offset(0, 1).Value
            Set oRangeDest = oRangeDest.Offset(1, 0) ' down one row for next time
            ' find next instance
            Set foundCell = oRangeSearch.FindNext(After:=foundCell)
            ' repeat until back where we started
        Loop Until firstFound = foundCell.Address
    End If

    Application.EnableEvents = True

End Sub

表格 A 和 B 的屏幕截图（被 alt 键稍微弄乱了......）：