同步Multipe工作表

Question

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

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

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

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

Sheet 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

Sheet 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}

Sheet 2中

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

表Sheet 3

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

Sheet4

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