Excel VBA : Sort, 然后复制并粘贴

Question

所有，我需要编写一个执行以下操作的宏:

1. On entry data into the last blank cell in column E, sort the entire worksheet by column E in descending order

2. Once the worksheet is sorted:

   2a. Copy the cell to the adjacent cell immediately to the left of the cell into which the data was first entered

2b. Paste the copied data into the first column of the same row from which the data was originally entered

2c. Move the cursor to the adjacent cell immediately to the right of the cell into which the data was first entered

下面，我展示了输入代码的排序，该代码有效。但是，我然后无法正确复制、粘贴和移动代码。我最常见的问题:输入数据后，行移动，但光标停留在首次输入数据的行中。有人可以帮忙吗？ (我什至无法在这篇文章上正确缩进!)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) Is Nothing) Then
        DoSort
    End If
End Sub

Private Sub DoSort()
    Worksheets("Sheet1").Range("A:E").Sort Key1:=Worksheets("Sheet1").Range("E1"), Order1:=xlDescending, Header:=xlYes
End Sub

Answer 1

关于1、2a和2b:在排序之前进行复制更简单。这样，复制的值将与其余值一起排序。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
        Is Nothing) Then
        ' First copy
        Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
        ' Then sort
        DoSort
    End If
End Sub

这就留下了问题 (2c):在对行进行排序后如何将事件单元格移动到适当的行。想必您希望用户在 F 列中输入更多数据？

同样，最直接的解决方案是首先进行此输入，然后进行排序。这将具有额外的好处，即用户不会让输入行在 E 列和 F 列中输入数据之间跳转。在用户输入所有数据之后，排序甚至可以只发生一次。

当然，以上更多的是设计建议，而不是针对您的特定任务 2c 的解决方案。如果您确实想要在排序后移动事件单元格，那么解决方案将不可避免地更加复杂。 Excel 的 Sort 方法不返回索引，以在排序后查找条目。您必须自己制作索引/“序列号”并在排序后进行搜索。这有效:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim newIndex As Long
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
        Is Nothing) Then
        ' Index the new entry in column B. (You can put the index elsewhere.)
        newIndex = WorksheetFunction.Max(Range("B:B")) + 1
        Target.Offset(0, -3).Value = newIndex
        ' Copy the entry.
        Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
        ' Sort
        DoSort
        ' Search for the new index after sorting. Select cell in column 6 (F).
        Cells(WorksheetFunction.Match(newIndex, Range("B:B"), 0), 6).Select
    End If
End Sub

如果您的所有条目都是唯一的(即没有重复项)，那么创建索引并不是绝对必要的；原则上您可以只搜索条目本身。但是，如果存在重复项，那么搜索条目本身(而不是其索引)将会更加困惑，并且可能会导致不需要的行为，除非它编程得恰到好处。我发现仅使用索引会更干净。