vba - 单元格值更改时自动运行 Excel vba 代码

Question

这个问题在这里已经有了答案:





Why MS Excel crashes and closes during Worksheet_Change Sub procedure?

(3 个回答)


6年前关闭。




我正在寻找一种在单元格值为零时自动启动某个 Sub 的方法。

例如。如果我在 Cell A1 中输入“0”，则应该运行以下 Sub

 Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"

如果我在单元格 A1 中输入 1(或任何其他大于 0 的值)，另一个 Sub 应该运行，例如

Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"

Sub 的调用应该在我在 excel 中输入值后立即发生，而无需按下按钮或其他任何东西。
有没有办法做到这一点？

Answer 1

让我们从这段代码开始，我将在下面解释。

打开 VB 编辑器 Alt+F11。右键单击您希望发生此行为的工作表，然后选择 View Code .

将以下代码复制并粘贴到工作表代码中。

Private Sub Worksheet_Change(ByVal Target As Range)
        'CountLarge is an Excel 2007+ property, if using Excel 2003 
        'change to just Count
        If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

        If Target.Address = "$A$1" Then
                If Target.Value = 0 Then
                        Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
                ElseIf Target.Value = 1 Then
                        Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
                End If
        End If

End Sub

Worksheet_Change每次用户对工作表进行更改时都会触发事件。例如，如果您更改单元格值，则会触发此事件。

该子例程中的第一行检查以确保没有更改多个单元格，并且实际上存在实际的单元格更改，如果其中一个不正确，则它将不会继续。

然后我们检查以确保单元格 A1 中发生了值更改，如果发生了，我们输入 IF陈述。

从那里，我们检查输入到单元格 A1 中的值.如果值为 0，则将适当的公式添加到 H32 .如果值为 1，则将适当的公式添加到 B15 .如果在单元格 A1 中输入了 0 或 1 以外的值，则不会发生任何事情。

重要的是要注意，您必须离开单元格才能触发此事件，因此虽然这是一个好的开始，但我目前不知道有一种方法可以在不至少按 enter 或离开单元格的情况下触发此事件。

更新

经过一番研究和玩弄，我想出了如何在不按 Enter 或任何其他按钮的情况下进行此更改，即使您正在编辑，这将在按下“0”或“1”后立即发生单元格值。我使用了 this previous SO question 中的键盘处理程序.
BEGIN KEYBOARD HANDLING 之间的代码和 END KEYBOARD HANDLING事件来自上面。

将以下代码复制并粘贴到您要在其上捕获这些击键的任何工作表的工作表代码中:

Option Explicit
'BEGIN KEYBOARD HANDLING

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MSG
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function WaitMessage Lib "user32" () As Long

Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long

Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long

Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE  As Long = &H1
Private Const WM_CHAR    As Long = &H102
Private bExitLoop As Boolean

Sub StartKeyWatch()

    Dim msgMessage As MSG
    Dim bCancel As Boolean
    Dim iKeyCode As Integer
    Dim lXLhwnd As Long

    'handle the ESC key.
    On Error GoTo errHandler:
    Application.EnableCancelKey = xlErrorHandler
   'initialize this boolean flag.
    bExitLoop = False
    'get the app hwnd.
    lXLhwnd = FindWindow("XLMAIN", Application.Caption)
    Do
        WaitMessage
        'check for a key press and remove it from the msg queue.
        If PeekMessage _
            (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
            'strore the virtual key code for later use.
            iKeyCode = msgMessage.wParam
           'translate the virtual key code into a char msg.
            TranslateMessage msgMessage
            PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
            WM_CHAR, PM_REMOVE
           'for some obscure reason, the following
          'keys are not trapped inside the event handler
            'so we handle them here.
            If iKeyCode = vbKeyBack Then SendKeys "{BS}"
            If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
           'assume the cancel argument is False.
            bCancel = False
            'the VBA RaiseEvent statement does not seem to return ByRef arguments
            'so we call a KeyPress routine rather than a propper event handler.
            Sheet_KeyPress _
            ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
            'if the key pressed is allowed post it to the application.
            If bCancel = False Then
                PostMessage _
                lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
            End If
        End If
errHandler:
        'allow the processing of other msgs.
        DoEvents
    Loop Until bExitLoop

End Sub

Sub StopKeyWatch()

    'set this boolean flag to exit the above loop.
    bExitLoop = True

End Sub

Private Sub Worksheet_Activate()
        Me.StartKeyWatch
End Sub

Private Sub Worksheet_Deactivate()
        Me.StopKeyWatch
End Sub

'End Keyboard Handling

Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)

        'CountLarge is an Excel 2007+ property, if using Excel 2003 
        'change to just Count
        If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

        If Target.Address = "$A$1" Then
                If KeyAscii = 48 Then
                        Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
                ElseIf KeyAscii = 49 Then
                        Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
                End If
        End If

End Sub

此外，右键单击 ThisWorkbook对象 --> 查看代码，并将此代码添加到:

Private Sub Workbook_Open()
        Sheets("Sheet1").StartKeyWatch
End Sub

一定要改 Sheet1无论您的工作表的名称是什么。

VBA 将“监听”按键，如果事件单元格是 A1 并且输入了 0 或 1，则即使在用户执行任何其他操作之前，也会执行适当的操作。

我要补充一点，他的性能代价很小，因为在 Workbook_Open 上执行的代码需要几秒钟才能运行。

感谢用户 Siddharth Rout指出 Count 的潜在问题从 Excel 2007 开始，并指导我使用 CountLarge反而。