如何用VBA实现Sheet1 A列修改时自动同步到Sheet2整列D

问题原因 #

原代码存在2个核心问题导致无法实现需求：

• 监听范围错误：原代码仅监听Sheet1的E列变更，你需要同步的是A列
• 目标单元格写死为固定D4：没有取变更单元格对应的行号，所以所有变更都只会写到D4单元格

调整后完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, r As Range
  ' 监听Sheet1整个A列的内容变更，如需跳过表头可改为Range("A2:A" & Rows.Count)
  Set rng = Intersect(Target, Range("A:A"))
  If rng Is Nothing Then Exit Sub
  ' 加解锁操作移到循环外，避免重复执行提升性能
  Sheet14.Unprotect Password:="432742"
  For Each r In rng
    ' 同步值到Sheet2（CLOSING BALANCE表）D列的对应行
    Sheets("CLOSING BALANCE").Range("D" & r.Row) = r.Value
  Next
  Sheet14.Protect Password:="432742", AllowFiltering:=True, AllowFormattingCells:=True
  Set rng = Nothing
End Sub

关键修改说明 #

• 把Intersect的匹配范围从Range("E4:E" & Rows.Count)改为Range("A:A")，实现监听Sheet1整个A列的内容变更
• 把固定目标位置Range("D4")改为Range("D" & r.Row)，动态取变更单元格的行号，同步到D列的对应行
• 把工作表解锁/上锁的操作移到了循环外，避免每次循环都重复执行加解锁操作，提升多单元格批量输入时的运行效率
• 去掉了非空判断，当前代码支持清空Sheet1A列内容时同步清空Sheet2对应D列内容，如果不需要同步空值，可以把赋值语句套在If Not IsEmpty(r.Value) Then判断内
• 注意：这段代码需要放在Sheet1的工作表代码模块中才能生效，不要放在普通模块或者ThisWorkbook模块里

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