使用VBA将可变文本字符串(时间戳)插入单元格

Question

我正在尝试简化在电子表格中记录的过程。我想在单元格中插入时间戳(具有特定格式)，然后继续键入注释。

这是我在 VBA 中的代码：

Sub timestamp()
Dim stringdate As String
Dim stringtime As String
Dim stamp As String


stringdate = Format(Now(), "mm/dd/yy")
stringtime = Format(Now(), "hh:mmA/P")
stamp = stringdate & " @" & stringtime & " KB- "

Selection.Value = stamp
'SendKeys "{F2}" /// not working
End Sub

这会以我想要的格式插入时间戳，但我有两个问题。(1)插入文本并且发送键不起作用后，我需要能够继续键入。(2)我还希望以后能够导航回该单元格，并在下面插入一个新的时间戳，并带有更多注释。

感谢您的任何帮助！

Answer 1

如果我了解您的问题，您想在编辑单元格时运行宏。那是不可能的。所以我想提供一个解决方法。 把它放在你的工作表模块中：

Const MAGIC_CHARACTER = "¤"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim stringdate As String
Dim stringtime As String
Dim stamp As String
Application.EnableEvents = False
stringdate = Format(Now(), "mm/dd/yy")
stringtime = Format(Now(), "hh:mmA/P")
stamp = stringdate & " @" & stringtime & " KB- "
Target.Value = Replace(Target.Value, MAGIC_CHARACTER, stamp)
Application.EnableEvents = True
End Sub

当您需要时间戳时，请输入魔术字符，该字符必须是您永远不会使用的内容，但您仍然可以在键盘上轻松访问。就我而言，我选择了"¤"，但您可能使用的是不同的键盘布局，因此请选择适合您的内容。离开单元格后，魔术字符将替换为时间戳。

Answer 2

你已经得到了一个答案，这里有一个稍微不同的方法：

您必须将其粘贴到工作表模块中，您将在其中键入笔记。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tAddress As Variant
tAddress = Split(Target.Address, "$")
If tAddress(1) = "B" And tAddress(2) > 1 Then
If Cells(tAddress(2), 1).Value = "" Then Cells(tAddress(2), 1) = Format(Now(), "mm/dd/yy: h:mm:ss AM/PM")
Application.SendKeys "{F2}", False
End If
End Sub

每当您选择B列中的任何单元格(B1除外)时，如果A列上它旁边的单元格为空白，它将为其添加时间戳并激活该单元格，以便您可以在其上键入。每当您移动到 B 列中的下一个单元格时，它都会再次执行此操作。如果您移回已经键入的单元格，它不会更改时间戳，但可以轻松编辑它。

Answer 3

感谢您的反馈。我决定使用以下代码：

Sub MyTimestamp()
'
' MyTimestamp Macro
' Insert KB Date/Time stamp into cell
'
' Keyboard Shortcut: Ctrl+Shift+D

Dim stringdate As String
Dim stringtime As String
Dim stamp As String
Dim current_value As String
stringdate = Format(Now(), "mm/dd/yy")
stringtime = Format(Now(), "hh:mmA/P")
stamp = stringdate & " @" & stringtime & " KB- "
current_value = Selection.Value
If current_value = "" Then
Selection.Value = current_value & stamp
Else: Selection.Value = current_value & Chr(10) & stamp
End If

Application.Wait (Now() + TimeValue("00:00:01"))
SendKeys "{f2}", True

End Sub