按存储在数组中作为变量的列对动态范围进行排序

Question

我正在尝试编写代码，其中有人可以输入列名列表，数据应该按照这些列名进行排序：

用于排序的数据是位于同一工作表上的动态范围：

下面是我目前的代码：

updateTab = Sheets("RAW_DATA_SO").Range("B8")

lastRow = Sheets("RAW_DATA_SO").Range("A1048576").End(xlUp).Row

 Dim sortBy() As String
   ReDim sortBy(lastRow - 12)

    For rowNumber = 12 To lastRow

    sortBy(rowNumber - 12) = Sheets("RAW_DATA_SO").Range("A" & rowNumber)

  Next
lastColumnAddress = Sheets("RAW_DATA_SO").Range("XFD1").End(xlToLeft).Address(False, False)
serchrange = "A1:" & lastColumnAddress
Set sortRange = Range(Cells(1, 10), Cells(lastRow, lastColumn))


For i = 0 To UBound(sortBy)

 Set FindColumn = Sheets("RAW_DATA_SO").Range(serchrange).Find(What:=sortBy(i), LookIn:=xlValues, LookAt:=xlWhole)

   sortByColumn = FindColumn.Address(ReferenceStyle)


    sortRange.Sort key1:=Range(sortByColumn), order1:=xlAscending, Header:=xlYes


Next

问题是数据一次只排序一列。如何重写数据按多列排序的排序过程？我找到了可以添加更多列的代码，但它们并不灵活，总是假设我们现在按数据将被排序的列数。我想让添加排序方式列表成为可能......

Answer 1

鉴于 VBA 一次最多可以执行三个键的排序，似乎最好向后遍历列出的排序键字段。

Sub dynamic_sort()
    Dim lc As Long, lr As Long, v As Long, k As Long, vKEYs As Variant

    With Sheets("RAW_DATA_SO")
        With .Range(.Cells(12, 1), .Cells(12, 1).End(xlDown))
            vKEYs = .Value2
        End With

        Debug.Print LBound(vKEYs, 1) & ":" & UBound(vKEYs, 1)
        Debug.Print LBound(vKEYs, 2) & ":" & UBound(vKEYs, 2)

        For k = LBound(vKEYs, 1) To UBound(vKEYs, 1)
            Debug.Print vKEYs(k, 1)
        Next k

        lr = .Cells(Rows.Count, 10).End(xlUp).Row
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column - 9
        With .Cells(1, 10).Resize(lr, lc)
            For v = UBound(vKEYs, 1) To 1 Step -3
                Select Case v
                    Case Is > 2
                        .Cells.Sort Key1:=.Columns(Application.Match(vKEYs(v - 2, 1), .Rows(1), 0)), Order1:=xlAscending, _
                                    Key2:=.Columns(Application.Match(vKEYs(v - 1, 1), .Rows(1), 0)), Order2:=xlAscending, _
                                    Key3:=.Columns(Application.Match(vKEYs(v, 1), .Rows(1), 0)), Order3:=xlAscending, _
                                    Orientation:=xlTopToBottom, Header:=xlYes
                    Case 2
                        .Cells.Sort Key1:=.Columns(Application.Match(vKEYs(v - 1, 1), .Rows(1), 0)), Order1:=xlAscending, _
                                    Key2:=.Columns(Application.Match(vKEYs(v, 1), .Rows(1), 0)), Order2:=xlAscending, _
                                    Orientation:=xlTopToBottom, Header:=xlYes
                    Case 1
                        .Cells.Sort Key1:=.Columns(Application.Match(vKEYs(v, 1), .Rows(1), 0)), Order1:=xlAscending, _
                                    Orientation:=xlTopToBottom, Header:=xlYes
                End Select
            Next v
        End With

    End With
End Sub

如果要排序的字段超过三个，则需要先对次要字段进行排序，然后在逐步接近主键时继续排序。

Select Case statement 提供三个排序选项，以便始终使用最大数量的键。

我可以从您的代码和示例图像中收集到的最好结果是 SORT BY 列标签位于“RAW_DATA_SO”！A11 中，排序键低于从 A12 开始的排序键。排序范围的左上角是 'RAW_DATA_SO'!J1 并且有一个标题行用于排序范围。

Answer 2

这是我很快敲出的一些代码，所以按列名排序......但你应该明白......

Public Sub SortColumns(ByVal DataTable As Range, ParamArray ColumnNames() As Variant)

    Dim vColName As Variant
    Dim rSortCol As Range

    DataTable.Parent.Sort.SortFields.Clear
    For Each vColName In ColumnNames
        Set rSortCol = FindColumn(DataTable, vColName)
        If Not rSortCol Is Nothing Then _
                DataTable.Parent.Sort.SortFields.Add Key:=rSortCol, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Next

    With DataTable.Parent.Sort
        .SetRange DataTable
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Public Function FindColumn(ByVal DataTable As Range, ByVal ColumnName) As Range

    Dim rPtr As Range, rHeader As Range

    Set rHeader = DataTable.Resize(1)
    Set rPtr = rHeader.Find(ColumnName, rHeader(rHeader.Count), XlFindLookIn.xlValues, XlLookAt.xlWhole)
    If Not rPtr Is Nothing Then Set FindColumn = rPtr.Resize(DataTable.Rows.Count)

End Function