присвоение приоритета на основе динамически меняющихся значений пользователя excel vba

Question

У меня есть список курсов в ячейке b и их соответствующих приоритетах в ячейке c от 1 до 49. Я хочу, чтобы пользователь менял любое значение столбца приоритета, т.е. «C ». то все остальные приоритеты должны быть соответствующим образом скорректированы. логику можно увидеть в прилагаемом листе. номера приоритетов должны динамически меняться, когда пользователь вводит значение. поэтому в примере один ссылочный столбец L в прилагаемом листе. , если пользователь изменит приоритет № 4 на 8, остальные останутся на один. Аналогично, теперь у нас есть новый список nos. поэтому, если какое-либо другое число изменится, оно должно соответствующим образом скорректировать, имея в виду новый список 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