Question

我希望有人能帮我一个workheet_change代码，我想扩展到很多领域。我做的每一次尝试都会在代码错误的情况下结束。

目前代码读作：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Not Intersect(Target, Range("b6,b33,b60,b87,b113,b140")) Is Nothing Then
    On Error Resume Next
    Application.EnableEvents = False
    Target.Offset(-3, 0) = Now
    Application.EnableEvents = True
    On Error GoTo 0
End If

If Target.Address = Range("D6").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B6:C6").Copy Range("B11:C11")
        Application.EnableEvents = True
    End If

End If

End Sub

我还想要包含的内容将第二个work_sheet更改项应用于同一工作表上的其他区域。所以，如果我重写那部分，它会读到：

If Target.Address = Range("D33").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B33:C33").Copy Range("B38:C38")
        Application.EnableEvents = True
    End If

If Target.Address = Range("D60").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B60:C60").Copy Range("B65:C65")
        Application.EnableEvents = True
    End If

If Target.Address = Range("D87").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B87:C87").Copy Range("B92:C92")
        Application.EnableEvents = True
    End If

If Target.Address = Range("D113").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B113:C113").Copy Range("B118:C118")
        Application.EnableEvents = True
    End If

If Target.Address = Range("D140").Address Then
    If Target = "Agent" Then
        Application.EnableEvents = False
        Range("B140:C140").Copy Range("B145:C145")
        Application.EnableEvents = True
    End If

非常感谢任何有关如何实际工作的帮助！

Answer 1

我走这条路：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As range)
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    If Not Intersect(Target, range("b6,b33,b60,b87,b113,b140")) Is Nothing Then
        On Error Resume Next
        Application.EnableEvents = False
        Target.Offset(-3, 0) = Now
        Application.EnableEvents = True
        On Error GoTo 0
    Else
        If Target.Value2 = "Agent" Then
            If Not Intersect(Target, range("D6,D33,D60,D87,D113,D140")) Is Nothing Then
                Application.EnableEvents = False
                Target.Offset(, -2).Resize(, 2).Copy Target.Offset(5,-2)
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

将Worksheet_Change扩展为多个范围值

1 个答案: