在表格的OPEN事件中加入
Private Sub Workbook_Open()
Application.OnKey "{UP}", "UP"
End Sub
复制代码
在模块中加入
Sub UP()
On Error Resume Next
Dim Rng As Range, x%
If Intersect(ActiveCell, Sheet1.Range("G3:G7")) Is Nothing Then Exit Sub
Set Rng = Sheet3.Range("J2:J7")
x = Right(ActiveCell.Address, 1) - 2
Rng(x) = Rng(x) + 1
End Sub