excel - 在 +/- 按键上增加/减少 ActiveCell 的值

Question

所以，我正在让自己成为 excel 中的游戏突袭追踪器。

该表通过不断激活的 VB 代码进行动态排序，除非我暂时停止代码。现在我需要一段代码，这样当我选择一个单元格并在键盘的小键盘上按 + 或 - 时，单元格中的值会增加或减少 1，而不是写入 +/-细胞内。

排序代码为:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A10:F192")) Is Nothing Then
Range("A10:F192").Sort _
Key1:=Range("C11"), Order1:=xlDescending, Header:=xlYes, _
Key2:=Range("F11"), Order2:=xlAscending, Header:=xlYes
End If
End Sub

这是来自内存，所以它可能有点偏离，但你应该明白这一点。那么我该如何实现这个增加/减少功能呢？

Answer 1

编辑:我修复了数字键盘的卡扣。

我得到它与 SendKeys 合作.将此添加到 ThisWorkbook目的:

Private Sub Workbook_Open()
    TogglePlusCatch
    ToggleMinusCatch
    Application.OnKey "{107}", "CatchPlus"
    Application.OnKey "{109}", "CatchMinus"
End Sub

并将其添加到模块中:
选项显式

Public blnCatchPlus As Boolean
Public blnCatchMinus As Boolean

Public Sub TogglePlusCatch()
    With Application
        If blnCatchPlus Then
            .OnKey "{+}"
            blnCatchPlus = False
        Else
            .OnKey "{+}", "CatchPlus"
            blnCatchPlus = True
        End If
    End With
End Sub

Public Sub CatchPlus()
    If blnCatchPlus Then
        Dim rngIntersection As Range

        Set rngIntersection = Intersect(Selection, Range("A10:F192"))

        If rngIntersection Is Nothing Then
            'the target range was not selected, so let the keystroke go through
            TogglePlusCatch
                SendKeys "{+}"
                DoEvents
            TogglePlusCatch
        Else
            IncrementOne rngIntersection, 1
        End If
    End If
End Sub

Public Sub ToggleMinusCatch()
    With Application
        If blnCatchMinus Then
            .OnKey "{-}"
            blnCatchMinus = False
        Else
            .OnKey "{-}", "CatchMinus"
            blnCatchMinus = True
        End If
    End With
End Sub

Public Sub CatchMinus()
    If blnCatchMinus Then
        Dim rngIntersection As Range

        Set rngIntersection = Intersect(Selection, Range("A10:F192"))

        If rngIntersection Is Nothing Then
            'the target range was not selected, so let the keystroke go through
            ToggleMinusCatch
                SendKeys "{-}"
                DoEvents
            ToggleMinusCatch
        Else
            IncrementOne rngIntersection, -1
        End If
    End If
End Sub

Private Sub IncrementOne(rngIntersection As Range, iIncrement As Integer)
    Dim rng As Range

    For Each rng In rngIntersection
        rng = rng + iIncrement
    Next rng
End Sub