excel - 项目 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

我确信有一种更简单的方法可以遍历单元格并重新排序列表。

标签： excelvba

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

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

所以我们只需要重写数字就可以了：