Question

我正在处理Excel工作表，其中每行需要指示该行中任何单元格的最后一次更改。我发现这样做的最简单的方法是在工作表代码中加入少量的VBA，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If (Target.Row > 2) And (Cells(Target.Row, "A") <> "") Then
        Cells(Target.Row, "N").Value = Date
    End If
    Application.EnableEvents = True
End Sub

这将有效地改变＆＃34; N＆＃34;列中编辑该行中的任何其他项时的列。大！解决了，除了......

因为我正在更改代码中的单元格值，所以撤消堆栈会立即丢失，当然这意味着此工作表中的任何工作都无法撤消。

所以，另一种方法是让excel认为我还没有编辑过一个单元格。此代码在更改日期时保留撤消堆栈：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~", True
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

在这种情况下，我们选择单元格，使用SendKeys伪造编辑单元格，并将光标恢复到原始位置。＆＃34; ^;〜＆＃34;正在使用Excel＆＃34; Ctrl +;＆＃34;输入日期的快捷方式。大！解决了，除了......

此代码在我的机器上运行良好（Win7，Excel 2010），但在同事的机器上失败（Win8，Excel 2010，可能更快一点）。在Win8机器上（不知道它是否是操作系统的问题，顺便说一句），会发生的情况是，无论何时更改单元格，紧接该单元格下方的每个单元格都会成为当前日期，当然保留撤消历史记录是没有意义的，因为执行撤消会立即重新激活工作表代码并再次将所有内容转换为日期。

我自己想出，如果我删除＆＃34; Wait＆＃34;我会在我的机器上发生同样的事情。 SendKeys命令中固有的。也就是说，如果我使用这行：

SendKeys "^;~", False

所以，我猜测的是，无论出于何种原因，即使使用相同版本的Excel，我的计算机也在等待SendKeys命令完成，但我的同事的计算机不是。有什么想法吗？

Answer 1

你是对的。它在Excel 2010 / Win8中提供了该问题。

试试这个。使用我编写的自定义Wait代码。（在Excel 2010 / Win8中测试）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~"
        Wait 1 '<~~ Wait for 1 Second
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

enter image description here

<强>替代

使用Doevents也会产生预期的效果。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~"
        DoEvents
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

Excel VBA：某些计算机上的SendKeys失败

1 个答案: