Приоритизация проектов VBA

Question

У меня есть список из 30 проектов, отображаемых в строках, мне нужно дать пользователю возможность изменить приоритет проектов в форме VBA.

Форма в порядке, пользователь может искать проектон хочет (нажав на поиск проекта), старый приоритет заполняется автоматически, и ему предлагается ввести новый приоритет:

НажатиемОК, новый приоритет для этого проекта должен заменить старый приоритет для этого проекта, и он должен переупорядочить все в столбце приоритетов.

Код, который у меня есть, почти работает, но оставляет целое, в примере нижеЯ изменил проект с приоритетом 3 на приоритет 10, он изменил весь столбец, но исчез с приоритетом проекта 3:

Этокод, который у меня есть:

(это действительно грязно, и я не могу придумать, как заставить это работать)

' After clicking on look for project , where cell focus in on the project he wants to change priority

Private Sub CommandButton1_Click()
Dim old_priority As String
Dim CELL As Range


ActiveCell.Offset(0, -1).Select
ActiveCell.Value = new_priority.Text

For Each CELL In Range("b8:b36")

   If CELL.Value >= new_priority.Text + 1 Then
   CELL.Value = CELL.Value + 1
   Else
   End If


   If CELL.Value = new_priority.Text Then
   CELL.Value = CELL.Value + 1
   Else
   End If

Next CELL

   ThisWorkbook.Sheets("sheet5").Range("c27").Value = new_priority.Text


    Cells.Find(What:=ThisWorkbook.Sheets("sheet5").Range("b27").Value, After:=ActiveCell, LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
    Prioridade.Text = ActiveCell.Offset(0, -1).Value
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Value = new_priority.Text



        Unload Me

End sub

Я уверен, что есть более простой способ прохождения цикла черезячейки и переупорядочить список.

Answer 1

Представьте себе следующие данные, где мы хотим изменить приоритет 3 на 10 (который уже существует), поэтому его нужно отсортировать прямо перед 10.

Тогда мы используем следующий код:

Option Explicit

Public Sub Test()
    ReOrder OldPriority:=3, NewPriority:=10
End Sub

Public Sub ReOrder(OldPriority As Long, NewPriority As Long)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle9")

    Dim MatchRow As Double
    On Error Resume Next
        MatchRow = Application.WorksheetFunction.Match(OldPriority, ws.Columns("A"), 0)
    On Error GoTo 0

    If MatchRow = 0 Then
        MsgBox "The old priority number did not exist.", vbCritical
        Exit Sub
    End If

    'write new priorty
    ws.Cells(MatchRow, "A").Value = NewPriority - 0.001 'subtract a small number so it will always sort before existing priorities

    'sort by priortiy
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=ws.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange ws.Range("A:B") 'your data range
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'rewrite priority numbers ascending
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 2 To LastRow
        ws.Cells(iRow, "A") = iRow - 1
    Next iRow
End Sub

После записи нового приоритета и сортировки данных по приоритету это выглядит так:

Так что нам просто нужно переписать числа, и мы окажемся здесь: