Worksheet_change代码用于不同纸张，并在一张纸上的数据

Question

我在30张列表中列出了下拉列表，其中C列是下拉列表。根据所选标准，在D列中粘贴了另一个值。

我创建的代码仅适用于我的数据所在的表格。我想根据我的“数据”表在文件中的每个电子表格上执行代码。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Res As Variant
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("c6:c10")) Is Nothing Then
Res = Evaluate("INDEX(b2:b63,MATCH(" & Target.Address & ",A2:a63,0))").
If Not IsError(Res) Then Target.Offset(, 1) = Res
End If
End Sub

该代码与我的值一起在页面上起作用。用我的数据从表格中制作代码是什么，适用于文件上的其余表？

也许select.worksheet.data在我的代码线之一或类似行之前？

Answer 1

如果您希望上述代码在所有其他纸张中都可以使用（更改特定表的“ C6：C10”范围中的某些内容，以在“ D：D”列中带来res相应的工作表），请在thisWorkBook代码模块中复制下一个代码事件（并从表中删除/评论现有的代码）：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim Res As Variant
  If Sh.name <> "MySheet1" Or Sh.name <> "MySheet2" Then 'sheet to be excepted (if the case)
     If Target.CountLarge > 1 Then Exit Sub
       If Not Intersect(Target, Sh.Range("c6:c10")) Is Nothing Then
            Res = Evaluate("INDEX(" & Sh.Range("B2:B63").Address(external:=True) & _
                     ",MATCH(" & Target.Address & "," & Sh.Range("A2:A63").Address(external:=True) & ",0))")
       If Not IsError(Res) Then Target.Offset(, 1) = Res
    End If
 End If
End Sub

但是，如果所有范围都有同步范围床单，需要复制与事件触发的表格中返回的res，请下一步改编您的代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Res As Variant, ws As Worksheet
 If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("c6:c10")) Is Nothing Then
        Res = Evaluate("INDEX(b2:b63,MATCH(" & Target.Address & ",A2:a63,0))")
    If Not IsError(Res) Then Target.Offset(, 1) = Res
 
    For Each ws In Me.Parent.Worksheets 'place the same Res in the correspondent cell from all sheets
        If ws.name <> "MySheet1" Or ws.name <> "MySheet2" Or ws.name <> Me.name Then  'except some sheets if necessary
           ws.Range(Target.Address).Offset(, 1).value = Res
        End If
    Next
 End If
End Sub

请，请在之后发送一些反馈测试看起来很方便的解决方案。