excel - 将数字添加到唯一但无序的数字列表 - 工作表更改

Question

我有一个 Excel 文件，其中包含 A 列中的数字列表和 B 列中的名称列表。这些数字是唯一的(没有重复的数字)，但数字不按顺序排列。它代表了我每天需要联系他们的顺序。

例如

3     John
2     Jane
5     James
1     Jonah
4     Jeremy

在这里，我将按顺序联系 Jonah、Jane、John、Jeremy 和 James。

我计划在列表中添加一个新人(凯特)，并计划联系她的第二个。新列表如下所示:

4     John
3     Jane
6     James
1     Jonah
5     Jeremy
2     Kate

现在，我将按顺序联系 Jonah、KATE、Jane、John、Jeremy 和 James。这里重要的事实是，新条目下方的所有数字保持不变，但等于或高于新条目的所有数字都会增加 1。有时我会在列表底部添加新条目，其他时候我会添加新条目通过在列表中间插入新行。有时我需要将人员从列表中删除，并且我想反转该事件(对于所有等于或大于新删除的数字的数字，他们将从原始值中减去1)。

我强烈怀疑我需要设置一个工作表更改事件...逻辑如下:

如果在目标范围内输入一个数字(在本例中为 A 列)，则A 列中所有大于或等于新输入数字的数字将是原始值 + 1。

如果从目标范围中删除一个数字，则目标范围内大于或等于新输入数字的所有数字都将是原始值 - 1。

在 VBA 中表达这一点的最佳方式是什么？

非常感谢!

Answer 1

以下是一些应该适合您的注释代码:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCheckA As Range, ATarget As Range, ACell As Range
    Dim varBefore As Variant
    Dim varAfter As Variant
    Dim lChangeType As Long
    Dim rngActive As Range

    Set rngCheckA = Me.Range("A1", Me.Cells(Me.Rows.Count, "A").End(xlUp))
    Set rngActive = ActiveCell

    Application.EnableEvents = False
    On Error GoTo CleanExit

    Set ATarget = Intersect(rngCheckA, Target)
    If Not ATarget Is Nothing Then
        'Code only runs if a single cell in column A was changed
        If ATarget.Cells.Count = 1 Then
            'Get previous value
            Application.Undo
            varBefore = ATarget.Value

            'Get new value
            Application.Undo
            varAfter = ATarget.Value

            'Check how list changed
            If Len(varBefore) = 0 And IsNumeric(varAfter) Then
                'New value was added to the list
                lChangeType = 1
            ElseIf Len(varAfter) = 0 And IsNumeric(varBefore) Then
                'Existing value was removed (deleted) from list
                lChangeType = 2
            ElseIf IsNumeric(varBefore) And IsNumeric(varAfter) Then
                'Existing value in list was changed
                lChangeType = 3
            End If

            'Update list values appropriately based on how the list was changed
            For Each ACell In rngCheckA.Cells
                If Len(ACell.Value) > 0 And IsNumeric(ACell.Value) And ACell.Address <> ATarget.Address Then
                    'Only need to update values in list that are greater than or equal to the changed value
                    If ACell.Value >= ATarget.Value Then
                        Select Case lChangeType
                            Case 1: ACell.Value = ACell.Value + 1                               'New value added, increase values
                            Case 2: ACell.Value = ACell.Value - 1                               'Existing value removed, decrease values
                            Case 3: If ACell.Value = ATarget.Value Then ACell.Value = varBefore 'Existing value changed, swap numbers
                        End Select
                    End If
                End If
            Next ACell
        End If
    End If

'In the event of any errors, turn EnableEvents back on
'The Application.Undo will change the selected cell, so set it back to what it was
CleanExit:
    Application.EnableEvents = True
    rngActive.Select

End Sub