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

时间:2013-05-31 20:59:23

标签: excel-vba excel-2010 vba excel

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

Automatically copy formulas as data expands

我的情况不同的是,我的公式所引用的数据不是整个以前的工作表。例如,我希望表单“B”中的公式使用表单“A”中的数据,该表单对应于包含字符串“XYZ”的单元格的行。工作表“A”链接到定期更新的数据源,更改包含所述字符串的行数。当“A”更新时,“B”计算它需要的东西,然后自动绘制(我已经有了一个子),但我无法弄清楚如何自动使公式范围反映数据的波动范围。

有什么想法吗?

1 个答案:

答案 0 :(得分:0)

根据我认为您尝试做的一些合理的假设,我编写并测试了以下代码片段(根据您的链接改编)。将其添加到工作表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键稍微弄乱了......):

enter image description here enter image description here