同步多个工作表

Question

我正在尝试让 Excel VBA 对工作表之间的链接数据进行“双向”更新。 Sheet1 是汇总表，Sheet2,3,4... 是更详细的数据。挑战在于数据输入可能出现在两个位置...在摘要表 1 中，或在其中一个连接的工作表中。

作为一个类比，这就像拥有一个年度预算摘要工作表，其中包含每个月支出的支持工作表。但是，可以在任一位置输入数据。

简而言之，如果您在Sheet1中并更改数据，它将更新Sheet2，Sheet3，Sheet4等，如果您在Sheet2，Sheet3，Sheet4中并更改数据，它将更新Sheet1中的汇总表.

我找到了一个类似的工作解决方案，可以在 Sheet1 和 Sheet2 之间更新单个单元格 A1：

表 1

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Sheets("Sheet2").Range("A1").Value = Target.Value
Application.EnableEvents = True
End Sub

表 2

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Sheets("Sheet1").Range("A1").Value = Target.Value
Application.EnableEvents = True
End Sub

但是，我真正想要的是一个更大的版本，以便在 Sheet1 中更新/同步多个其他工作表中的数据行“汇总表”。每个工作表对应于 Sheet1 表中的一行。

这是工作表所包含内容的简化示例。

Sheet1“汇总表”

A1:C1 'Row 1 data in Summary Table {1,2,3}
A2:C2 'Row 2 data in Summary Table {4,5,6}
Ai:Ci 'Row i data in Summary Table (7,8,9}

表 2

A1:C1 'Data Corresponding to Summary Table Row 1 {1,2,3}

表 3

A1:C1 'Data Corresponding to Summary Table Row 2 {4,5,6}

表 4

A1:C1 'Data Corresponding to Summary Table Row 3 {7,8,9}

对此问题的任何建议将不胜感激！ 谢谢！

Sheet1 Sheet2 Sheet3 Sheet4

Answer 1

您正在寻找这样的东西。确保将代码放在ThisWorkbook 代码模块中。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim wsSummary As Worksheet
    Dim rSummaryTable As Range
    Dim rChanged As Range
    Dim ChangedCell As Range
    Dim wsTest As Worksheet

    Set wsSummary = ThisWorkbook.Sheets("Sheet1")   'Set to actual name of your Summary Sheet
    Set rSummaryTable = wsSummary.Range("A:C")      'Set to the actual columns you want to monitor in the Summary sheet

    Application.EnableEvents = False

    If Sh.Name = wsSummary.Name Then
        Set rChanged = Intersect(rSummaryTable, Target)
        If Not rChanged Is Nothing Then
            For Each ChangedCell In rChanged.Cells
                On Error Resume Next
                Set wsTest = ThisWorkbook.Sheets(ChangedCell.Row + 1)
                On Error GoTo 0
                If wsTest Is Nothing Then Set wsTest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsTest.Cells(1, ChangedCell.Column).Value = ChangedCell.Value
                wsSummary.Activate
            Next ChangedCell
        End If
    Else
        Set rChanged = Intersect(Sh.Range(rSummaryTable.Cells(1).Address).Resize(, rSummaryTable.Columns.Count), Target)
        If Not rChanged Is Nothing Then
            For Each ChangedCell In rChanged.Cells
                rSummaryTable.Cells(Sh.Index - 1, ChangedCell.Column - rSummaryTable.Column + 1).Value = ChangedCell.Value
            Next ChangedCell
        End If
    End If

    Application.EnableEvents = True

End Sub