首页 文章

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

提问于
浏览 次
1

我想知道是否有人可以使用以下代码提供建议 . 它运行良好，直到我将下拉列表添加到"D4"单元格中（更准确地说，它们是合并单元格"D4:F4"） . 除了"lists"表之外，D4单元格中的这些下拉列表位于工作簿的所有工作表上并保留相同的数据 . 这些源数据位于工作表"lists"上的命名表中，并使用 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
excel vba excel-vba

1 回答

  • 0

    尝试将代码放在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

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

    回复于

相关问题