Question

所以，我在excel中做了一个游戏raid跟踪器。

该表通过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

增加/减少ActiveCell在+/- keypress上的值

1 个答案: