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

在写入新的优先级并按优先级对数据进行排序后，它看起来像这样：

所以我们只需要重写数字，我们就到这里：