Question

我在Excel中有一个优先级列表，例如：

4, 
1,
3,
2

如果我输入新名称并指定优先级，我希望它自动更新优先级。例如，如果新名称的优先级为2。

5,
1,
4,
3,
2

我有以下VBA代码，应该可以完成这项工作，但我无法让它运行。

Sub Worksheet_Change(ByVal Target As Range)
    Dim rngPriorityList As Range
    Dim lNewValue As Integer
    Dim myCell As Range

    If IsNumeric(Target.Value) Then 'Only run if the a number was entered

        Set rngPriorityList = Intersect(Target, Range("I3:I500")) 'the named range for the task list

        If Not Intersect(Target, rngPriorityList) Is Nothing Then 'Only run the following in the cell being updated was in the priority list range
            If Target.Value >= 1 Then
            For Each myCell In rngPriorityList.Cells 'Loop through the priority list range
                If myCell.Value = Target.Value _
                And myCell.Address <> Target.Address Then 'Finding cells with the same value, excluding the cell being changes
                    myCell.Value = myCell.Value + 1 'Increment the prioriry by 1
                End If
            Next myCell
            End If
        End If
    End If
End Sub

Answer 1

可能的纠正

rngprioritylist的错误设置（应该是Range（“I3：I500”i.o. intersect（...））

错误的mycell.value测试（应该是＆gt; = i.o. =）

在调整优先级期间应禁用

事件，因为修改优先级将触发worksheet_change事件。

Sub Worksheet_Change(ByVal Target As Range)
    Dim rngPriorityList As Range
    Dim lNewValue As Integer
    Dim myCell As Range

    If IsNumeric(Target.Value) Then 'Only run if the a number was entered

        Set rngPriorityList = Range("I3:I500") 'the named range for the task list

        If Not Intersect(Target, rngPriorityList) Is Nothing Then 'Only run the following in the cell being updated was in the priority list range
            If Target.Value >= 1 Then
            Application.EnableEvents = False
            For Each myCell In rngPriorityList.Cells 'Loop through the priority list range
                If myCell.Value >= Target.Value _
                And myCell.Address <> Target.Address Then 'Finding cells with the same value, excluding the cell being changes
                    myCell.Value = myCell.Value + 1 'Increment the prioriry by 1
                End If
            Next myCell
            Application.EnableEvents = True
            End If
        End If
    End If
End Sub

自动重新编号优先级列表VBA

1 个答案: