Question

我希望编写代码：

将单元格A14复制到第H列的第一行
向下移动整个列（最新数据在上面），
，然后在值I更改时在第I列中添加时间戳

但我似乎无法让它运行正常。

我正在尝试实时跟踪这些值并创建时间序列图。

这需要自己执行。

有什么想法吗？

Private Sub Gain(ByVal target As Range)
Application.EnableEvents = True


Do While cell("A14") <> cell("H1")
If cell("H1") <> cell("A14") Then
Range("H1:J1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A14").Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A16").Select
Application.CutCopyMode = False
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("B16").Select
Application.CutCopyMode = False
Selection.Copy
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Columns("I:I").Select
Application.CutCopyMode = False
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
Columns("J:J").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("H:H").Select
Selection.NumberFormat = "$#,##0.00"
Next

End Sub

Answer 1

这将跟踪所有更改并将当前时间粘贴到列I中。看起来您的复制和粘贴代码应该正常工作;如果没有，请告诉我们您遇到的错误或结果（如果有的话）。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
rng = Range("A:A")

If Intersect(Target, rng) Is Nothing Then
    'Do nothing
Else:

    If Target.Value <> Now Then

        Cells(Target.Row, 9).Value = Now
        Cells(Target.Row, 9).NumberFormat = "hh:mm:ss"
    Else
    End If
End If

End Sub

更改时复制和粘贴值

1 个答案: