Question

我是excel vba的新手，如果你能帮助我，我真的很感激。事情是我有每小时更新的单元格，因为它与Blomberg的功能相关联。问题是，我希望每次单元格更新excel复制它并粘贴到另一个新单元格，我可以观察到日内变化。我已经提出了一些代码，但我只能复制并粘贴到一个类似的单元格中。它看起来如下：

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


If Not Intersect(Target, Range("E4")) Is Nothing Then
Range("E4").Copy
Range("E4").PasteSpecial xlPasteValues
End If

End Sub

任何帮助都将受到高度赞赏。

Answer 1

如果我正确理解您的问题，您想将值复制到新单元格，以便进行日志记录？在这种情况下我要做的是另一张用于记录名为“logger_sheet”的值的表格。当blomberg单元格更新时，我在单元格 a1 中粘贴一个值，将值复制到我的 logger_sheet cell a2 当它改变时将其复制到a3然后a4等。

这是您的更新代码。它假设您有一个名为“logger_sheet”的工作表（如果您没有，创建它）来存储所有以前的值。当blomberg单元更新时，它会复制该值并将其粘贴到下一个可用的logging_sheet单元格中。我开发了一个函数，用于查找指定工作表和列中最后使用的行。试一试

如果你想防止excel闪烁，你还可以取消注释，我在代码中将其标记为

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

    target_cell = "E4"
    col_to_log_data = "A"
    logging_Sheet = "logger_sheet"

    If Not Intersect(Target, Range("E4")) Is Nothing Then
        'uncomment this line to stop the "flashing"
        'Application.ScreenUpdating = False

        'gets the name of the current sheet
        data_sheet = Range(target_cell).Parent.Name
        Range(target_cell).Select
        Selection.Copy

        'gets the next free row from column a of the logging sheet (the next free row is
        'the last used row + 1)
        next_free_row = GetLastRowByColumn(CStr(col_to_log_data), CStr(logging_Sheet)) + 1

        'pastes the value
        Sheets(logging_Sheet).Range(col_to_log_data & CStr(next_free_row)).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

        'switches back to the data sheet
        Sheets(data_sheet).Select

        'make sure you turn screen updating on (if it was never off it still works)
        Application.ScreenUpdating = True
    End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this finds the last row in a specific column
'PARAMS: col_to_check, the clumn we want the last row of
'        Opt: sheet_name, the sheet you want to check last row of
'             default is current sheet if not specified
'RETURN: the last row number used in the sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRowByColumn(col_to_check As String, Optional sheet_name As String)

    'gets current sheet name
    the_current_sheet = ActiveSheet.Name

    'if the user didnt' specify a sheet use the current one
    If (Len(sheet_name) = 0) Then
        sheet_name = the_current_sheet
    End If

    'gets last row
    GetLastRowByColumn = Sheets(sheet_name).Range(col_to_check & "65536").End(xlUp).Row

    'returns to original sheet
     Sheets(the_current_sheet).Select
End Function

如果我的答案解决了您的问题，请将其标记为解决方案

Answer 2

这个怎么样？每次E4改变时，它都会将E4转移到新的行中。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$E$4" Then Sheets("Sheet2").Cells(Rows.Count, "F").End(xlUp).Offset(1) = Target

End Sub

Answer 3

我假设您要记录每次值的变化。我建议将日志保存在单独的表格中。我们称之为LogSheet。

Sub  WriteLog(ByRef r As range)
Dim Lastrow as integer
With ThisWorkBook.WorkSheets("LogSheet")
LastRow = .Cells(.Rows.Count,"A").End(XlUp).Row
.Range("A" & LastRow + 1).Value = Now & " - " & r.Value
End With
End Sub

这个子程序基本上会用时间戳写下我们日志表A列的所有更改！

现在，我们需要对您的代码进行更改，以便在出现更改时生成日志。为此，我们将调用我们的函数并告诉复制范围的内容（“E4”）（一直在更新的内容）

If Not Intersect(Target, Range("E4")) Is Nothing Then
'add this line
WriteLog(ActiveSheet.Range("E4"))

立即尝试。

更新单元格并将其粘贴到另一个单元格vba

3 个答案: