Excel VBA实现两区域同步更新：一方变更时另一方同步同值

Here's a complete, robust VBA solution to sync your two ranges (B3:B9 and D3:D9) whenever either is modified. This fixes the infinite loop issue and handles both single and multiple cell changes:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Area1 As Range, Area2 As Range
    Dim intersectRange As Range
    Dim cell As Range
    Dim relativeRow As Long
    
    ' Define the two ranges you want to keep in sync
    Set Area1 = Me.Range("B3:B9")
    Set Area2 = Me.Range("D3:D9")
    
    ' Disable events temporarily to prevent infinite loops
    Application.EnableEvents = False
    
    ' Error handler to ensure events are always re-enabled
    On Error GoTo Cleanup
    
    ' Check if the changed cells are in Area1
    Set intersectRange = Application.Intersect(Target, Area1)
    If Not intersectRange Is Nothing Then
        For Each cell In intersectRange
            ' Calculate the position of the changed cell relative to Area1's top
            relativeRow = cell.Row - Area1.Row + 1
            ' Update the corresponding cell in Area2
            Area2.Cells(relativeRow, 1).Value = cell.Value
        Next cell
    End If
    
    ' Check if the changed cells are in Area2
    Set intersectRange = Application.Intersect(Target, Area2)
    If Not intersectRange Is Nothing Then
        For Each cell In intersectRange
            relativeRow = cell.Row - Area2.Row + 1
            ' Update the corresponding cell in Area1
            Area1.Cells(relativeRow, 1).Value = cell.Value
        Next cell
    End If

Cleanup:
    ' Re-enable events regardless of success/failure
    Application.EnableEvents = True
    ' Show error message if something went wrong
    If Err.Number <> 0 Then
        MsgBox "Error syncing ranges: " & Err.Description, vbExclamation
        Err.Clear
    End If
End Sub

Key Details: #

• Infinite Loop Prevention: Application.EnableEvents = False stops the code from triggering itself when it updates the second range. We re-enable events in the Cleanup block to ensure normal Excel behavior resumes.
• Multiple Cell Handling: The loop processes each changed cell individually, so pasting a range into either area will sync all corresponding cells correctly.
• Relative Position Calculation: relativeRow finds where the changed cell sits within its range, so we can map it to the exact same position in the other range.
• Error Safety: The error handler ensures events are always turned back on, even if an unexpected error occurs (like trying to paste non-text values).

How to Use: #

1. Right-click the worksheet tab where your ranges are located.
2. Select View Code to open the VBA editor for that sheet.
3. Paste the code above into the editor window.
4. Close the VBA editor and test by changing a value in either B3:B9 or D3:D9—you’ll see the corresponding cell in the other range update instantly.

内容的提问来源于stack exchange，提问作者Selrac