☰

Excel 不同工作表和不同范围内的双向链接

tag-icon • tag-icon microsoft-excel links visual-basic
Excel 不同工作表和不同范围内的双向链接

我正在尝试以双向链接的方式链接两个单元格区域。这意味着，如果您更改一个单元格中的值，则会更改其他单元格中的值，反之亦然。

以供参考：

Excel：源工作表和目标工作表上的单元格的双向链接

当两张工作表上的范围相同时，解决方案会非常有效，但是在我的工作簿上，我不能使用相同的范围。

在示例中，它对所有工作表使用范围 a2：D5，但我想让它从第一张工作表上的 a2：D5 到第二张工作表上的 H3：K6 进行工作。

我尝试过很多方法，但是我对 Visual Basic 的了解非常有限，甚至过了几个小时，我还是找不到任何解决方案。

真的谢谢你 :-)

答案1

首先，一些免责声明

  • 这是我的第一次编写 Excel Visual Basic 代码。
  • 这段代码几乎肯定是未经优化的，并且很可能会出现一些导致问题的边缘情况；正确的复制和同步代码是很难写。
  • 此代码确实可以更加模块化；使用发布-订阅模型将链接表连接在一起将大有裨益。目前，代码是复制粘贴的，特别注意修改哪个文件中的哪些表是目标（参见差异）。
  • 有几乎可以确定以更好的方式去做你想做的事情。
  • ⚠️请不要将此代码用于生产用途。请将其视为一项学术练习。⚠️

演示和示例文件

演示该功能

文件：https://www.dropbox.com/s/e23izdjd1vm83pw/superuser-1406612-two-way-sync-across-sheets.xlsm?dl=0

现在，代码

Table1从in同步Sheet1到Table2in Sheet2：

Public PriorCount As Long
Public PriorRows As Long
Public PriorColumns As Long

Private Sub Worksheet_Activate()
    PriorCount = Application.Range("Table1").ListObject.Range.Cells.Count
    PriorRows = Application.Range("Table1").ListObject.ListRows.Count
    PriorColumns = Application.Range("Table1").ListObject.ListColumns.Count
End Sub

'
' When I wrote this code, only God and I understood it.
'
' Now, only God knows.
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
' TODO: Handle column/row deletions that alter where the Table's absolute position is (low priority)
'
' if something goes wrong, let the user know
' and give up, being sure to re-activate events
On Error GoTo OhNo

' get references to both table objects
Dim table1 As ListObject
Set table1 = Application.Range("Table1").ListObject
Dim table2 As ListObject
Set table2 = Application.Range("Table2").ListObject

' get current count of cells and rows/cols
Dim CurrentCount As Long
Let CurrentCount = table1.Range.Cells.Count
Dim CurrentRows As Long
Let CurrentRows = table1.ListRows.Count
Dim CurrentColumns As Long
Let CurrentColumns = table1.ListColumns.Count

' if our current row or column counts differ from prior,
' *and* there is no intersection between the target and
' table, then it means that we've removed rows or columns
' on the edge.
If Application.Intersect(Range(Target.Address), table1.Range) Is Nothing _
    And ((CurrentRows <> PriorRows) Or (CurrentColumns <> PriorColumns)) Then

    ' Debug.Print "Edge removal"

    ' Turn off events to avoid infinite loop
    Application.EnableEvents = False

    ' calculate the offset between Table1 and Table2
    table1Row = table1.Range.Row
    table1Col = table1.Range.Column
    table2Row = table2.Range.Row
    table2Col = table2.Range.Column
    
    ' these directions must be switched between
    ' Sheet1 and Sheet2. the row and col offset
    ' tell us which direction to move to apply
    ' the change in the other sheet. here, we go
    ' from Table1 to Table2, so we subtract 1 from 2
    rowOffset = table2Row - table1Row
    colOffset = table2Col - table1Col

    ' this is actually a pretty straightforward thing to sync.
    ' get the edge of the rows or cols, and delete everything
    ' past that in the other table.

    ' removing rows
    If CurrentRows < PriorRows Then
    
        RowsToRemove = PriorRows - CurrentRows
        RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Row
        
        table2.DataBodyRange.Offset(RemoveWhereTable2 - table2Row - 1, 0) _
            .Resize(RowsToRemove, table2.DataBodyRange.Columns.Count) _
            .Rows.Delete
    
    End If
    
    ' removing columns
    If CurrentColumns < PriorColumns Then
    
        ColsToRemove = PriorColumns - CurrentColumns
        RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Column
        
        table2.DataBodyRange.Offset(0, RemoveWhereTable2 - table2Col) _
            .Resize(table2.DataBodyRange.Rows.Count, ColsToRemove) _
            .Columns.Delete
    
    End If
    
    ' turn events back on
    Application.EnableEvents = True

End If

' if the change occurred anywhere inside Table1, then sync it to
' Table2 as well
If Not Application.Intersect(Range(Target.Address), table1.Range) Is Nothing Then

    ' calculate the offset between Table1 and Table2
    table1Row = table1.Range.Row
    table1Col = table1.Range.Column
    table2Row = table2.Range.Row
    table2Col = table2.Range.Column
    
    ' these directions must be switched between
    ' Sheet1 and Sheet2. the row and col offset
    ' tell us which direction to move to apply
    ' the change in the other sheet. here, we go
    ' from Table1 to Table2, so we subtract 1 from 2
    rowOffset = table2Row - table1Row
    colOffset = table2Col - table1Col

    ' we're adding rows or columns
    If CurrentCount > PriorCount Then
    
        ' Debug.Print "Added"
        ' The only way for a target to be non-empty
        ' and for CurrentCount > PriorCount is for
        ' the user to be adding an entry to the
        ' bottom of the list or the right. let's
        ' check for that.
        
        ' let's assume target is totally empty
        targetEmpty = True
        For Each cell In Target.Cells
            ' for adding rows, everything is empty.
            ' but for columns, the first row isn't empty.
            ' it's a default column header string.
            If cell.Value <> Empty And Not cell.Value Like "Column*" Then
                targetEmpty = False
                Exit For
            End If
        Next
        
        ' if not... go to Escape. We're adding to the bottom or right.
        If targetEmpty = False Then GoTo Escape
        
        ' otherwise... handle injecting rows or columns.
        ' Disable events to perform updates on table2.
        Application.EnableEvents = False
        
        ' figure out what we're adding and where
        
        ' adding rows
        If CurrentRows > PriorRows Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            RowsToAdd = CurrentRows - PriorRows
            AddWhereTable2 = Target.Offset(rowOffset, colOffset).Row
            
            For i = 1 To RowsToAdd
                table2.ListRows.Add (AddWhereTable2 - table2Row + i - 1)
            Next
        
        ' adding columns
        ElseIf CurrentColumns > PriorColumns Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            ColsToAdd = CurrentColumns - PriorColumns
            AddWhereTable2 = Target.Offset(rowOffset, colOffset).Column
            
            For i = 1 To ColsToAdd
                table2.ListColumns.Add (AddWhereTable2 - table2Col + i)
            Next
        
        End If
        
        ' update globals
        PriorCount = CurrentCount
        PriorRows = CurrentRows
        PriorColumns = CurrentColumns
        
        ' turn events back on
        Application.EnableEvents = True
        
    ' we're removing rows or columns
    ElseIf CurrentCount < PriorCount Then
        Debug.Print "Deleted"
        
        ' turn off events to apply updates
        Application.EnableEvents = False
        
        ' removing rows
        If CurrentRows < PriorRows Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            RowsToRemove = PriorRows - CurrentRows
            RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Row
            
            table2.DataBodyRange.Offset(RemoveWhereTable2 - table2Row - 1, 0) _
                .Resize(RowsToRemove, table2.DataBodyRange.Columns.Count) _
                .Rows.Delete
        
        ' removing columns
        ElseIf CurrentColumns < PriorColumns Then
        
            ColsToRemove = PriorColumns - CurrentColumns
            RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Column
            
            table2.DataBodyRange.Offset(0, RemoveWhereTable2 - table2Col) _
                .Resize(table2.DataBodyRange.Rows.Count, ColsToRemove) _
                .Columns.Delete
        
        End If
        
        ' update globals
        PriorCount = CurrentCount
        PriorRows = CurrentRows
        PriorColumns = CurrentColumns
        
        ' turn events back on
        Application.EnableEvents = True
        
    ' we're editing existing rows ; not adding or removing of rows
    Else

' escape hatch for adding to bottom or right
Escape:

        ' pause the application events, because other wise,
        ' they will trigger an infinite loop.
        Application.EnableEvents = False
        
        ' actually update the sheet that triggered Worksheet_Change
        '
        ' this macro is for sheet1, so apply the change without offset there.
        Sheets(1).Range(Target.Address).Value = Target.Value
        ' sync the updates to the table in the other sheet, being sure
        ' to offset the update since the other table might be in a
        ' different spot
        '
        ' this macro is for sheet1, so apply the change to Table2
        Sheets(2).Range(Target.Offset(rowOffset, colOffset).Address).Value = Target.Value
        
        ' start the application events again.
        Application.EnableEvents = True
        
    End If
    
End If

BailOut:
    Application.EnableEvents = True
    Exit Sub
OhNo:
    MsgBox Err.Description
    Resume BailOut

End Sub

Table2从in同步Sheet2到Table1in Sheet1：

Public PriorCount As Long
Public PriorRows As Long
Public PriorColumns As Long

Private Sub Worksheet_Activate()
    PriorCount = Application.Range("Table2").ListObject.Range.Cells.Count
    PriorRows = Application.Range("Table2").ListObject.ListRows.Count
    PriorColumns = Application.Range("Table2").ListObject.ListColumns.Count
End Sub

'
' When I wrote this code, only God and I understood it.
'
' Now, only God knows.
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
' TODO: Handle column/row deletions that alter where the Table's absolute position is (low priority)
'
' if something goes wrong, let the user know
' and give up, being sure to re-activate events
On Error GoTo OhNo

' get references to both table objects
Dim table1 As ListObject
Set table1 = Application.Range("Table1").ListObject
Dim table2 As ListObject
Set table2 = Application.Range("Table2").ListObject

' get current count of cells and rows/cols
Dim CurrentCount As Long
Let CurrentCount = table2.Range.Cells.Count
Dim CurrentRows As Long
Let CurrentRows = table2.ListRows.Count
Dim CurrentColumns As Long
Let CurrentColumns = table2.ListColumns.Count

' if our current row or column counts differ from prior,
' *and* there is no intersection between the target and
' table, then it means that we've removed rows or columns
' on the edge.
If Application.Intersect(Range(Target.Address), table2.Range) Is Nothing _
    And ((CurrentRows <> PriorRows) Or (CurrentColumns <> PriorColumns)) Then

    ' Debug.Print "Edge removal"

    ' Turn off events to avoid infinite loop
    Application.EnableEvents = False

    ' calculate the offset between Table1 and Table2
    table1Row = table1.Range.Row
    table1Col = table1.Range.Column
    table2Row = table2.Range.Row
    table2Col = table2.Range.Column
    
    ' these directions must be switched between
    ' Sheet1 and Sheet2. the row and col offset
    ' tell us which direction to move to apply
    ' the change in the other sheet. here, we go
    ' from Table1 to Table2, so we subtract 1 from 2
    rowOffset = table1Row - table2Row
    colOffset = table1Col - table2Col

    ' this is actually a pretty straightforward thing to sync.
    ' get the edge of the rows or cols, and delete everything
    ' past that in the other table.

    ' removing rows
    If CurrentRows < PriorRows Then
    
        RowsToRemove = PriorRows - CurrentRows
        RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Row
        
        table1.DataBodyRange.Offset(RemoveWhereTable1 - table1Row - 1, 0) _
            .Resize(RowsToRemove, table1.DataBodyRange.Columns.Count) _
            .Rows.Delete
    
    End If
    
    ' removing columns
    If CurrentColumns < PriorColumns Then
    
        ColsToRemove = PriorColumns - CurrentColumns
        RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Column
        
        table1.DataBodyRange.Offset(0, RemoveWhereTable1 - table1Col) _
            .Resize(table1.DataBodyRange.Rows.Count, ColsToRemove) _
            .Columns.Delete
    
    End If
    
    ' turn events back on
    Application.EnableEvents = True

End If

' if the change occurred anywhere inside Table1, then sync it to
' Table2 as well
If Not Application.Intersect(Range(Target.Address), table2.Range) Is Nothing Then

    ' calculate the offset between Table1 and Table2
    table1Row = table1.Range.Row
    table1Col = table1.Range.Column
    table2Row = table2.Range.Row
    table2Col = table2.Range.Column
    
    ' these directions must be switched between
    ' Sheet1 and Sheet2. the row and col offset
    ' tell us which direction to move to apply
    ' the change in the other sheet. here, we go
    ' from Table1 to Table2, so we subtract 1 from 2
    rowOffset = table1Row - table2Row
    colOffset = table1Col - table2Col

    ' we're adding rows or columns
    If CurrentCount > PriorCount Then
    
        ' Debug.Print "Added"
        ' The only way for a target to be non-empty
        ' and for CurrentCount > PriorCount is for
        ' the user to be adding an entry to the
        ' bottom of the list or the right. let's
        ' check for that.
        
        ' let's assume target is totally empty
        targetEmpty = True
        For Each cell In Target.Cells
            ' for adding rows, everything is empty.
            ' but for columns, the first row isn't empty.
            ' it's a default column header string.
            If cell.Value <> Empty And Not cell.Value Like "Column*" Then
                targetEmpty = False
                Exit For
            End If
        Next
        
        ' if not... go to Escape. We're adding to the bottom or right.
        If targetEmpty = False Then GoTo Escape
        
        ' otherwise... handle injecting rows or columns.
        ' Disable events to perform updates on table2.
        Application.EnableEvents = False
        
        ' figure out what we're adding and where
        
        ' adding rows
        If CurrentRows > PriorRows Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            RowsToAdd = CurrentRows - PriorRows
            AddWhereTable1 = Target.Offset(rowOffset, colOffset).Row
            
            For i = 1 To RowsToAdd
                table1.ListRows.Add (AddWhereTable1 - table1Row + i - 1)
            Next
        
        ' adding columns
        ElseIf CurrentColumns > PriorColumns Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            ColsToAdd = CurrentColumns - PriorColumns
            AddWhereTable1 = Target.Offset(rowOffset, colOffset).Column
            
            For i = 1 To ColsToAdd
                table1.ListColumns.Add (AddWhereTable1 - table1Col + i)
            Next
        
        End If
        
        ' update globals
        PriorCount = CurrentCount
        PriorRows = CurrentRows
        PriorColumns = CurrentColumns
        
        ' turn events back on
        Application.EnableEvents = True
        
    ' we're removing rows or columns
    ElseIf CurrentCount < PriorCount Then
        Debug.Print "Deleted"
        
        ' turn off events to apply updates
        Application.EnableEvents = False
        
        ' removing rows
        If CurrentRows < PriorRows Then
        
            ' for adding/removing rows/cols, they've
            ' already been added to Table1. Just need
            ' to update Table2
            RowsToRemove = PriorRows - CurrentRows
            RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Row
            
            table1.DataBodyRange.Offset(RemoveWhereTable1 - table1Row - 1, 0) _
                .Resize(RowsToRemove, table1.DataBodyRange.Columns.Count) _
                .Rows.Delete
        
        ' removing columns
        ElseIf CurrentColumns < PriorColumns Then
        
            ColsToRemove = PriorColumns - CurrentColumns
            RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Column
            
            table1.DataBodyRange.Offset(0, RemoveWhereTable1 - table1Col) _
                .Resize(table1.DataBodyRange.Rows.Count, ColsToRemove) _
                .Columns.Delete
        
        End If
        
        ' update globals
        PriorCount = CurrentCount
        PriorRows = CurrentRows
        PriorColumns = CurrentColumns
        
        ' turn events back on
        Application.EnableEvents = True
        
    ' we're editing existing rows ; not adding or removing of rows
    Else

' escape hatch for adding to bottom or right
Escape:

        ' pause the application events, because other wise,
        ' they will trigger an infinite loop.
        Application.EnableEvents = False
        
        ' actually update the sheet that triggered Worksheet_Change
        '
        ' this macro is for sheet2, so apply the change without offset there.
        Sheets(2).Range(Target.Address).Value = Target.Value
        ' sync the updates to the table in the other sheet, being sure
        ' to offset the update since the other table might be in a
        ' different spot
        '
        ' this macro is for sheet2, so apply the change to Table2
        Sheets(1).Range(Target.Offset(rowOffset, colOffset).Address).Value = Target.Value
        
        ' start the application events again.
        Application.EnableEvents = True
        
    End If
    
End If

BailOut:
    Application.EnableEvents = True
    Exit Sub
OhNo:
    MsgBox Err.Description
    Resume BailOut

End Sub

差异显示了哪些引用发生了变化：

6,8c6,8
<     PriorCount = Application.Range("Table1").ListObject.Range.Cells.Count
<     PriorRows = Application.Range("Table1").ListObject.ListRows.Count
<     PriorColumns = Application.Range("Table1").ListObject.ListColumns.Count
---
>     PriorCount = Application.Range("Table2").ListObject.Range.Cells.Count
>     PriorRows = Application.Range("Table2").ListObject.ListRows.Count
>     PriorColumns = Application.Range("Table2").ListObject.ListColumns.Count
32c32
< Let CurrentCount = table1.Range.Cells.Count
---
> Let CurrentCount = table2.Range.Cells.Count
34c34
< Let CurrentRows = table1.ListRows.Count
---
> Let CurrentRows = table2.ListRows.Count
36c36
< Let CurrentColumns = table1.ListColumns.Count
---
> Let CurrentColumns = table2.ListColumns.Count
42c42
< If Application.Intersect(Range(Target.Address), table1.Range) Is Nothing _
---
> If Application.Intersect(Range(Target.Address), table2.Range) Is Nothing _
61,62c61,62
<     rowOffset = table2Row - table1Row
<     colOffset = table2Col - table1Col
---
>     rowOffset = table1Row - table2Row
>     colOffset = table1Col - table2Col
72c72
<         RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Row
---
>         RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Row
74,75c74,75
<         table2.DataBodyRange.Offset(RemoveWhereTable2 - table2Row - 1, 0) _
<             .Resize(RowsToRemove, table2.DataBodyRange.Columns.Count) _
---
>         table1.DataBodyRange.Offset(RemoveWhereTable1 - table1Row - 1, 0) _
>             .Resize(RowsToRemove, table1.DataBodyRange.Columns.Count) _
84c84
<         RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Column
---
>         RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Column
86,87c86,87
<         table2.DataBodyRange.Offset(0, RemoveWhereTable2 - table2Col) _
<             .Resize(table2.DataBodyRange.Rows.Count, ColsToRemove) _
---
>         table1.DataBodyRange.Offset(0, RemoveWhereTable1 - table1Col) _
>             .Resize(table1.DataBodyRange.Rows.Count, ColsToRemove) _
99c99
< If Not Application.Intersect(Range(Target.Address), table1.Range) Is Nothing Then
---
> If Not Application.Intersect(Range(Target.Address), table2.Range) Is Nothing Then
112,113c112,113
<     rowOffset = table2Row - table1Row
<     colOffset = table2Col - table1Col
---
>     rowOffset = table1Row - table2Row
>     colOffset = table1Col - table2Col
153c153
<             AddWhereTable2 = Target.Offset(rowOffset, colOffset).Row
---
>             AddWhereTable1 = Target.Offset(rowOffset, colOffset).Row
156c156
<                 table2.ListRows.Add (AddWhereTable2 - table2Row + i - 1)
---
>                 table1.ListRows.Add (AddWhereTable1 - table1Row + i - 1)
166c166
<             AddWhereTable2 = Target.Offset(rowOffset, colOffset).Column
---
>             AddWhereTable1 = Target.Offset(rowOffset, colOffset).Column
169c169
<                 table2.ListColumns.Add (AddWhereTable2 - table2Col + i)
---
>                 table1.ListColumns.Add (AddWhereTable1 - table1Col + i)
196c196
<             RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Row
---
>             RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Row
198,199c198,199
<             table2.DataBodyRange.Offset(RemoveWhereTable2 - table2Row - 1, 0) _
<                 .Resize(RowsToRemove, table2.DataBodyRange.Columns.Count) _
---
>             table1.DataBodyRange.Offset(RemoveWhereTable1 - table1Row - 1, 0) _
>                 .Resize(RowsToRemove, table1.DataBodyRange.Columns.Count) _
206c206
<             RemoveWhereTable2 = Target.Offset(rowOffset, colOffset).Column
---
>             RemoveWhereTable1 = Target.Offset(rowOffset, colOffset).Column
208,209c208,209
<             table2.DataBodyRange.Offset(0, RemoveWhereTable2 - table2Col) _
<                 .Resize(table2.DataBodyRange.Rows.Count, ColsToRemove) _
---
>             table1.DataBodyRange.Offset(0, RemoveWhereTable1 - table1Col) _
>                 .Resize(table1.DataBodyRange.Rows.Count, ColsToRemove) _
234,235c234,235
<         ' this macro is for sheet1, so apply the change without offset there.
<         Sheets(1).Range(Target.Address).Value = Target.Value
---
>         ' this macro is for sheet2, so apply the change without offset there.
>         Sheets(2).Range(Target.Address).Value = Target.Value
240,241c240,241
<         ' this macro is for sheet1, so apply the change to Table2
<         Sheets(2).Range(Target.Offset(rowOffset, colOffset).Address).Value = Target.Value
---
>         ' this macro is for sheet2, so apply the change to Table2
>         Sheets(1).Range(Target.Offset(rowOffset, colOffset).Address).Value = Target.Value

相关内容