如果满足某些条件，请加盖时间戳并将行复制到另一张工作表 [英] Timestamping and copying a line to another sheet, if certain condition met

问题描述

我需要我的审核列表来:(1)在当前行的末尾添加一个时间戳，然后(2)在指定的行中标记为"N"或"n"的情况下，将该行复制到另一张纸上柱子.这个想法是要获得复制的不符合项的摘要.

I need my audit list to (1) add a time stamp in the end of current line and then (2) copy the line to the other sheet, when there is a "N" or "n" marked in the specified column. The idea is to get a summary of copied non-conformities.

我的麻烦是，就我使用的代码而言，它只能正确处理第一列.它与他人无关.

My trouble is that in the case of the code I use, it only deals with the first column correctly. It does nothing with others.

我使用下面的代码.

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

推荐答案

似乎您想查看是否已将 N 键入或粘贴到D:I列中，且操作结果略有不同 Target 的位置.许多动作是相同的.实际上，它们将时间戳记在K列中，然后复制到Sheet9中. If/ElseIf/ElseIf/End If可以通过分别处理每个问题而起作用，但是您应该能够将所有相同的动作堆叠在一起.

It seems that you want to see if an N has been typed or pasted into column D:I with slightly varying actions resulting from the location of Target. Many of the actions are the same; essentially they timestamp in column K and copy across to Sheet9. An If/ElseIf/ElseIf/End If would work for this by dealing with each individually but you should be able to stack all of the same actions together.

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列，您不需要为每一列使用单独的例程.

If an N is typed or pasted in D:I, a timestamp is put into column K and the row is copied to Sheet9. If the value is deleted from D:I, the timestamp is removed and no copy operation is made. By making the offset always point to column K, you do not require individual routines for each column.

这篇关于如果满足某些条件，请加盖时间戳并将行复制到另一张工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！