Question

我想知道是否有人可以使用以下代码提供建议。它运行良好，直到我将下拉列表添加到“D4”单元格中（更确切地说，它们是合并单元格“D4：F4”）。 D4单元格中的这些下拉列表位于工作簿的所有工作表上，除了“列表”表并保留相同的数据。这些源数据位于工作表“列表”的命名表中，并使用INDIRECT函数进行引用。我想要实现的是，如果我从任何一张纸上的下拉列表中选择一个项目，“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

像这样，您的代码将适用于任何工作簿表。

Worksheet_change事件 - 从下拉列表中选择时更改所有工作表上的单元格值

1 个答案: