Excel 在满足特定条件的情况下，为一行添加时间戳并将其复制到另一页

我需要我的审核列表1在当前行的末尾添加一个时间戳，然后2将该行复制到另一张表中，当指定列中有一个N或N标记时。这样做的目的是对复制的不符合项进行总结

我的问题是，在我使用的代码中，它只正确处理第一列。它与其他人无关

我使用下面的代码

Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrHandler
    Application.EnableEvents = False

    If Target.Column = 9 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("I:I"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 2)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 2).Clear
                End If
            Next
        End If

    If Target.Column = 9 And UCase(Target) = "N" Then
    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)

    If Target.Column = 8 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("H:H"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 3)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 3).Clear
                End If
            Next
        End If
    If Target.Column = 8 And UCase(Target) = "N" Then
    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)

    If Target.Column = 7 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("G:G"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 4)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 4).Clear
                End If
            Next
        End If
    If Target.Column = 7 And UCase(Target) = "N" Then
    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)


    If Target.Column = 6 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("F:F"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 5)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 5).Clear
                End If
            Next
        End If
    If Target.Column = 6 And UCase(Target) = "N" Then
    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)

    If Target.Column = 5 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("E:E"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 6)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 6).Clear
                End If
            Next
        End If
    If Target.Column = 5 And UCase(Target) = "N" Then

    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)

    If Target.Column = 4 And UCase(Target) = "N" Then
        Set rChange = Intersect(Target, Range("D:D"))
        If Not rChange Is Nothing Then
            Application.EnableEvents = False
            For Each rCell In rChange
                If rCell > "" Then
                    With rCell.Offset(0, 7)
                        .Value = Now
                        .NumberFormat = "dd/mm/yyyy"
                    End With
                Else
                    rCell.Offset(0, 7).Clear
                End If
            Next
        End If
    If Target.Column = 4 And UCase(Target) = "N" Then
    Target.EntireRow.Copy Destination:=Sheet9.Range("A" & _
    Rows.Count).End(xlUp).Offset(1)

    End If
    End If
    End If
    End If
    End If
    End If
    End If

    End If
    End If
    End If
    End If
    End If

    ErrHandler:
    Application.EnableEvents = True

End Sub

---

如果缩进正确，您的问题很容易识别

前两个其他问题：

请不要在例程的顶部包含On Error GoTo ErrHandler。这只意味着忽略任何错误。您应该尝试识别可能产生错误的语句，并修复导致这些错误的问题。 目标不必像代码假定的那样是单个单元格。例如，用户可能复制或清除了一个范围。 下面是例程开头的缩进版本，删除Then和Else主体，以便您可以看到问题

Sub Worksheet_Change(ByVal Target As Range)

  If Target.Column = 9 And UCase(Target) = "N" Then
    If Not rChange Is Nothing Then
    End If

    ' We are already within If Target.Column = 9 And UCase(Target) = "N"
    ' So this If adds nothing
    If Target.Column = 9 And UCase(Target) = "N" Then

      ' We are within If Target.Column = 9 And UCase(Target) = "N"
      ' So the Then block of this If will never be executed 
      If Target.Column = 8 And UCase(Target) = "N" Then
        If Not rChange Is Nothing Then
        End If

      If Target.Column = 8 And UCase(Target) = "N" Then

        If Target.Column = 7 And UCase(Target) = "N" Then

你需要使用If。。如果。。。如果。。。其他的如果构造结束，则结束

Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False

  If UCase(Target) = "N" Then

    If Target.Column = 9 Then
      If Not rChange Is Nothing Then
      End If

      ' Delete because unnecessary
      'If Target.Column = 9 Then

    ElseIf Target.Column = 8 Then
      If Not rChange Is Nothing Then
      End If

      ' Delete because unnecessary
      'If Target.Column = 8 Then

    ElseIf Target.Column = 7 Then
      If Not rChange Is Nothing Then
      End If

      ' Delete because unnecessary
      'If Target.Column = 7 Then

    ElseIf Target.Column = 6 Then

    : : : :

    End If

  End If

---

如果我理解你的代码，大部分的重复是不必要的。试试我建议的改变。如果它们起作用，我将向您展示如何更广泛地整理代码。

您似乎想看看是否已在D:I列中键入或粘贴了一个N，并且由于目标位置的不同，操作略有不同。许多行为是相同的；基本上，它们在K列中加上时间戳，并复制到第9页。If/ElseIf/ElseIf/End If可以单独处理每个操作，但您应该能够将所有相同的操作堆叠在一起

Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D:I")) Is Nothing Then
        On Error GoTo ErrHandler
        Application.EnableEvents = False
        Dim rChange As Range
        For Each rChange In Intersect(Target, Range("D:I"))
            If UCase(rChange.Value2) = "N" Then
                Cells(rChange.Row, "K") = Now
                Cells(rChange.Row, "K").NumberFormat = "dd/mm/yyyy"
                Cells(rChange.Row, "A").EntireRow.Copy _
                  Destination:=Sheet9.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            ElseIf Not CBool(Len(rChange.Value)) Then
                Cells(rChange.Row, "K").ClearContents
            End If
        Next rChange
    End If

ErrHandler:
    Application.EnableEvents = True

End Sub

---

如果在D:I中键入或粘贴了N，则时间戳将放入K列，该行将复制到Sheet9。如果从D:I中删除该值，则时间戳将被删除，并且不会进行任何复制操作。通过使偏移量始终指向K列，您不需要对每列执行单独的例程。

查看您发布的代码，这是VBA for excel。您已将此问题标记为Google电子表格问题。我已经为你更改了标签，现在你有机会得到答案了。@MikeDove-。