Worksheet_change事件 – 从下拉列表中进行select时，更改所有工作表上的单元格值

我想知道是否有人可以build议使用下面的代码。 它运行良好，直到我将下拉列表添加到“D4”单元（更确切地说，它们是合并的单元格“D4：F4”）。 D4单元格中的这些下拉列表位于除“列表”表单外的所有工作簿上，并保存相同的数据。 这些源数据位于表“列表”上的命名表中，并使用INDIRECT函数进行引用。 我想达到的是，如果我从任何一张纸上的下拉列表中select一个项目，“D4”单元格值将在其他纸张上自动更改。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim wb1 As Workbook Dim ws1 As Worksheet With Application .EnableEvents = False .ScreenUpdating = False End With Set wb1 = ThisWorkbook Set ws1 = wb1.ActiveSheet If Target.Cells.Count > 1 Then GoTo LetsContinue 'Change cell value on all sheets except for sheet "lists" If Not Intersect(Target, ws1.Range("D4")) Is Nothing Then For Each ws In wb1.Worksheets If ws.Name <> "lists" Then If Target.Value <> ws.Range(Target.Address).Value Then ws.Range(Target.Address).Value = Target.Value End If End If Next ws Else GoTo LetsContinue End If LetsContinue: With Application .EnableEvents = True .ScreenUpdating = True End With End Sub 

Answer 1

尝试将您的代码作为Workbook模块中的Worbook_SheetChange事件而不是使用工作表事件：

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim wb1 As Workbook Dim ws1 As Worksheet With Application .EnableEvents = False .ScreenUpdating = False End With Set wb1 = ThisWorkbook Set ws1 = Sh If Target.Cells.Count > 1 Then GoTo LetsContinue 'Change cell value on all sheets except for sheet "lists" If Not Intersect(Target, ws1.Range("D4")) Is Nothing Then For Each ws In wb1.Worksheets If ws.Name <> "Lists" Then If Target.Value <> ws.Range(Target.Address).Value Then ws.Range(Target.Address).Value = Target.Value End If End If Next ws Else GoTo LetsContinue End If LetsContinue: With Application .EnableEvents = True .ScreenUpdating = True End With End Sub 

像这样，你的代码将与工作簿的任何工作表一起工作。