我正在寻找一种在单元格的值为零时自动启动某个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中输入值后立即执行,而不按任何其他按钮。 有没有办法做到这一点?
答案 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 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指出了Excel 2007中Count
的潜在问题,并指示我使用CountLarge
。