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

时间:2015-07-31 14:23:31

标签: excel vba excel-vba

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

E.g。如果我在Cell A1中输入“0”,则应该运行以下Sub

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

如果我在Cell A1中输入1(或任何其他值大于0),则应运行另一个Sub,例如

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

调用Sub应该在我在excel中输入值后立即执行,而不按任何其他按钮。 有没有办法做到这一点?

1 个答案:

答案 0 :(得分:4)

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

打开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以外的值,则不会发生任何操作。

重要的是要注意,你必须让这个事件的单元格触发,所以虽然这是一个好的开始,但我目前还不知道如何在没有按下输入的情况下触发此事件或离开牢房。

更新

经过一些研究和游戏后,我已经弄清楚如何在不按下输入或任何其他按钮的情况下进行此更改,这将在“0”之后立即发生。或者' 1'即使您正在编辑单元格值,也会按下。我使用了来自this previous SO question的键盘处理程序。

BEGIN KEYBOARD HANDLINGEND 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指出了Excel 2007中Count的潜在问题,并指示我使用CountLarge

相关问题