Question

我在单元格b中有列表课程，并且在单元格c中从1到49有各自的优先级。我想要的是用户是否改变优先级列的任何值，即“C”。然后应相应调整所有其他优先级。逻辑可以在附表中看到。优先级数字应在用户输入值时动态更改。所以在示例一中，参考附页中的列L. 如果用户将no 4优先级更改为8，则其余的将更改为1。同样现在我们有了新的名单。因此，如果任何其他数字发生变化，则应相应调整，同时记住新列表 sheet snapshot attached

尝试下面的代码，但它总是以值1再次开始。因此，不会根据新列表调整值。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
Dim iCount As Long

Dim cell As Range
Dim myRange As Range
Set myRange = Worksheets("Sheet1").Range("C1:C49")

If Intersect(Target, Range("C1:C49")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

myVal = Target.Value
iCount = 1
For Each cell In myRange
    If Intersect(Target, cell) Is Nothing Then
        If iCount = myVal Then
            iCount = iCount + 1
        End If
        cell.Value = iCount
        iCount = iCount + 1
    End If
Next cell


Application.EnableEvents = True

End Sub

Answer 1

当第一行是任何行时编辑工作

生成了以下内容......

来自此代码...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ExtVal As Variant, InsVal As Variant
Dim iLoop As Long
Dim InsRow As Long, ExtRow As Long
Dim foundArr() As Boolean

Dim myRange As Range

    ' initial settings
    Set myRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim foundArr(1 To myRange.Rows.Count)
    For iLoop = 1 To myRange.Rows.Count
        foundArr(iLoop) = False
    Next iLoop

    If Intersect(Target, myRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

    ' calculate the extracted value - the user entered value
    ExtVal = Target.Value
    ' calculate the inserted value - the number the user typed over
    For iLoop = 1 To myRange.Rows.Count
        foundArr(myRange.Cells(iLoop, 1).Value) = True
    Next iLoop
    For iLoop = 1 To myRange.Rows.Count
        If Not foundArr(iLoop) Then
            InsVal = iLoop
            Exit For
        End If
    Next iLoop

    ' calculate the insertion row - the row the user typed in.
    InsRow = CLng(Right(Target.Address, 1))
    ' calculate the extraction row - the original row of the number the user typed
    ExtRow = 0
    For iLoop = 1 To myRange.Rows.Count
        If myRange.Cells(iLoop, 1).Value = ExtVal And myRange.Cells(iLoop, 1).Row <> InsRow Then
            ExtRow = myRange.Cells(iLoop, 1).Row
            Exit For
        End If
    Next iLoop

    ' do the swap / shuffle
    Application.EnableEvents = False

    For iLoop = myRange.Rows.Count To 1 Step -1
        Debug.Print "Evaluating Row " & myRange.Cells(iLoop, 1).Row
        If (myRange.Cells(iLoop, 1).Row <= ExtRow) Then
            If myRange.Cells(iLoop, 1).Row > InsRow + 1 Then
                myRange.Cells(iLoop, 1).Value = myRange.Cells(iLoop - 1, 1).Value
            Else
                If myRange.Cells(iLoop, 1).Row = InsRow + 1 Then
                    myRange.Cells(iLoop, 1).Value = InsVal
                End If
            End If
        End If
    Next iLoop

    Application.EnableEvents = True
End Sub

根据用户动态更改值excel vba分配优先级

1 个答案: