根据范围对列集合进行排序答案

【问题标题】：Sorting a collection of columns based on a range根据范围对列集合进行排序
【发布时间】：2015-12-12 03:39:54
【问题描述】：

我已经在 Google 和 Stack 中搜索了我正在尝试做的示例，虽然我找到了一些示例来执行我正在尝试做的部分，但我无法实现预期的结果。我已经包含了下面的代码，看起来它会做我想要完成的事情。不幸的是，我得到一个“下标超出范围”，我认为这与我的语法有关。

根据包含的屏幕截图，我正在尝试按照“Sheet1”上 A 列中找到的值的顺序对“Sheet2”上找到的列进行排序。从概念上讲，

我认为最好的方法是将 sheet1 中的值分配给一个数组，将 sheet2 中的列分配给一个数组，然后根据 array1 对 array2 进行排序。

关于如何实现这一点的任何想法？任何帮助表示赞赏：

Public Sub sortColumn()
Dim rng As Range
Dim i As Integer
Dim J As Integer
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
Dim Arr As Variant


nams = Array(Worksheets("Sheet1").Range("A1:A350").Value2)

Set rng = Worksheets("Sheet2").Range("B1:JS1")
For i = 1 To rng.Columns.Count
    For J = i To rng.Columns.Count
        For F = 0 To UBound(nams)
            If nams(F) = rng(J) Then Dex = F: Exit For
        Next F
        If F < i Then
            Temp = rng.Columns(i).value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
    Next J
Next i


End Sub

如上所述，上述代码会导致“子脚本超出范围”。我已经检查了范围名称，它们是有效的。下图显示了我正在使用的内容：

【问题讨论】：

您可以根据表格一创建自定义列表，将表格二从左到右排序，然后删除您刚刚创建的自定义列表。与this 相同
当您创建自定义列表时，该列表保持静态。不幸的是，sheet1 上的值不断变化，
每次运行代码时，它都会查找一张表并根据那里的内容创建一个新的自定义列表。然后，当您对工作表 2 进行排序时，它会被删除。将所有内容加载到数组中，将该数组传递到自定义列表中。每次运行都会改变。
我看到自定义列表发生了变化。但是我在 sheet2 上尝试了自定义排序的所有变体

标签： arrays vba excel sorting

【解决方案1】：

如果使用以下公式将一行添加到第二张纸的顶部，则可以在没有 VBA 的情况下实现：

=MATCH(B2,Sheet1!$A:$A,0)

在 B1 中复制到适合，然后在 ColumnsB 上按 Row1 排序。

【讨论】：

【解决方案2】：

正如 OP 的 cmets 中所讨论的那样。

首先根据 sheet1 上的内容创建一个自定义列表（我将它们放在一起）：

Dim cstListArr() As Variant
cstListArr = wst1.Range(Range("A1"), Range("A1").End(xlDown))
Application.AddCustomList ListArray:=cstListArr

然后从左到右排序

Set srtRng = wst2.Range(Range("B1"), Range("B1").End(xlDown).End(xlToRight))

wst2.Sort.SortFields.Clear
srtRng.Sort Key1:=wst2.Range("B1:JS1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal

然后摆脱刚刚创建的自定义排序。

Application.DeleteCustomList Application.CustomListCount

所以大家一起来：

Dim wst1 As Worksheet
Dim wst2 As Worksheet
Set wst1 = ActiveWorkbook.Worksheets("Sheet1")
Set wst2 = ActiveWorkbook.Worksheets("Sheet2")
Dim srtRng As Range

wst1.Activate
Dim cstListArr() As Variant
cstListArr = wst1.Range(Range("A1"), Range("A1").End(xlDown))
Application.AddCustomList ListArray:=cstListArr

wst2.Activate
Set srtRng = wst2.Range(Range("B1"), Range("B1").End(xlDown).End(xlToRight))

wst2.Sort.SortFields.Clear
srtRng.Sort Key1:=wst2.Range("B1:JS1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
    Orientation:=xlLeftToRight, DataOption1:=xlSortNormal


Application.DeleteCustomList Application.CustomListCount

【讨论】：