使用Excel VBA按列值对数据进行排序，降序和升序

Question

我一直在研究一个VBA宏，它导出SolidWorks界面中每个选定行的单位矢量值，我想在将单位矢量写入Excel之前对其进行排序。我需要将Excel范围B2排序为D2（B2表示单位矢量的部分i，C2表示部分j，D2表示部分k），范围取决于所选行的数量。每个选定的线代表一个向量，每个向量代表Excel中的一行。

我想按列D对它们进行排序，然后我想用单元格D2中的最大值（单元格D3中的最小值）对它们进行排序，并让它从那里升序。它将首先上升，然后从第二行下降。

因此，如果有四个选定的行，D列将如下所示：

-0.99221 -1 -0.99789 -0.99664

目前它看起来像这样：

Excel截图

但它不知道最初需要排序多少行。以下是相关代码：

Dim r As Long
Dim ws As Worksheet
Set ws = ActiveSheet

For q = 3 To NumberOfSelectedItems
Columns("B:D").Sort key1:=Range("D2:D2"), order1:=xlDescending, Header:=xlYes
r = ws.Cells(ws.Rows.Count, 4).End(xlUp).Rows
Range("B3:D2" & r).Sort key1:=Range("D2:D2"), order1:=xlAscending, Header:=xlNo
bRes = WriteToExcel(((q - 1) * 1) + 1, vModelSelPt4, "Unit Vector")
Next

目前，代码给出了1004错误。我认为这是一个小问题，但是我不确定。如何按上述顺序按D栏订购？

Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean

    'get the results into excel

    With xlWorkbook.ActiveSheet
        .Cells(startRow + 2, 2).Value = data(0)
        .Cells(startRow + 2, 3).Value = data(1)
        .Cells(startRow + 2, 4).Value = data(2)
    End With
End Function

上面的代码是将数据写入Excel的功能;这是非常相关的。这一切都在SolidWorks API中完成，因此语法略有不同。

Answer 1

除了您的自定义函数WriteToExcel的行（您未在代码示例中包含，因此我认为无关紧要）之外，您问题中的所有帖子都没有给我任何错误。

所以，除非你在这个函数中有错误，否则上面的代码应该完美无缺。

对于排序，我建议您将列D升序排序，然后将排序表的行（列D中的最大值）从表格底部移到顶部。以下sub就是这样做的：

Option Explicit

Public Sub SortIt()

Dim lngLastRow As Long

With ThisWorkbook.Worksheets(1)
    lngLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("D2:D" & lngLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange Range("A1:D" & lngLastRow)
        .Header = xlYes
        .Apply
    End With
    .Range("A2:D" & lngLastRow).Copy Destination:=Range("A3")
    .Range(.Cells(lngLastRow + 1, 1), .Cells(lngLastRow + 1, 4)).Cut _
        Destination:=Range("A2")
End With

End Sub

请注意，上面的代码假定表格位于表格1上。如果不是这样，那么您应该调整代码。如果您有任何问题或有任何问题，请告诉我。

编辑：将复制命令更改为剪切。