VBA代码按列名，不同位置对多列进行排序答案

【问题标题】：VBA code to sort multiple columns by column name, differing locationsVBA代码按列名，不同位置对多列进行排序
【发布时间】：2014-02-25 10:40:42
【问题描述】：

我是 VBA 编码的新手，想要一个对多列进行排序的 VBA 脚本。我首先从最小到最大对 F 列进行排序，然后对 K 列进行排序。但是，我希望 Range 值基于列名而不是位置是动态的（即 F 列中的值称为“名称”，但是“名称”不会总是在 F 列中）

我希望更改宏中的所有 Range 值，并且正在考虑用 FIND 函数替换它，我在正确的轨道上吗？

即更改范围_ ("F1:F10695")

类似于Range (Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(Selection, Selection.End(xlDown)).Select

我还看到了一些 VBA 脚本模板，它们使用 Dim 和 Set 函数来创建列表，即设置 x="Name"，然后对矩阵中的 X 进行排序。这是更好的方法吗？感谢您的帮助，我在下面附上了基本的 VBA 脚本模板

Sub Macro2()
'
' Macro2 Macro
'

'
    Selection.AutoFilter
    Range("F1").Select
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("F1:F10695"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("K1").Select
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("K1:K10695"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

【问题讨论】：

所以，您需要始终按“名称”列排序，然后按“K”列排序吗？如果“名称”在“K”中会怎样？您需要对哪些列（我的意思是整个范围）进行排序？
在上面的代码中，F 列标题为“名称”，K 列标题为“日期”。所以我总是想先按“名称”排序，然后按“日期”排序，但它们并不总是在 F 列和 K 列中。我希望代码包含整个工作表。谢谢
听起来像是使用Application.Match 的简单问题。我认为 simoco 已经对此有了一个想法，但是如果您向我们提供整个范围覆盖范围，即使标题位置发生变化，它也会有所帮助。你的数据在哪里，即。 A:AX、C:Z 等等？另外，Date 的排序顺序是否也在增加？您提到的`我首先对F列从最小到最大进行排序，然后对K列进行排序`这仍然有点模糊。 :)
您能解释一下 application.match 是如何工作的吗？为澄清起见，数据范围是 A1:V1000，但这总是在变化。我提取的报告将具有不同的列和行金额/订单，但“名称”和“日期”的列标题将始终相同。它必须先对 Name 递增排序，然后再对 Date 递增排序。谢谢！

标签： vba excel sorting

【解决方案1】：

UPD：

试试这个：

Sub test()

    Dim rngName As Range
    Dim rngDate As Range
    Dim emptyDates As Range

    Dim ws As Worksheet
    Dim lastrow As Long


    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws
        Set rngName = .Range("1:1").Find(What:="Name", MatchCase:=False)
        Set rngDate = .Range("1:1").Find(What:="Date", MatchCase:=False)

        If Not rngName Is Nothing Then
            lastrow = .Cells(.Rows.Count, rngName.Column).End(xlUp).Row
            On Error Resume Next
            Set emptyDates = .Range(rngDate, .Cells(lastrow, rngDate.Column)).SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
            If Not emptyDates Is Nothing Then
                emptyDates.EntireRow.Delete
            End If
        End If

        With .Sort
            .SortFields.Clear
            If Not rngName Is Nothing Then
                .SortFields.Add Key:=rngName, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End If
            If Not rngDate Is Nothing Then
                .SortFields.Add Key:=rngDate, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End If
            .SetRange ws.Cells
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

End Sub

注意事项：

将ThisWorkbook.Worksheets("Sheet1") 行中的Sheet1 更改为适合您的工作表名称
代码尝试在第一行查找“姓名”和“日期”，然后，如果找到此项目，则添加与该列对应的SortFields
作为 cmets 的后续行动，OP 还希望删除日期为空的行

【讨论】：

似乎只对 Name 列进行了排序，但 Date 列没有排序..？不过谢谢你，我会尝试调整这个
代码在两列上排序，首先它按名称对工作表进行排序，然后按日期对每组相同名称（如果存在）进行排序。
好的，我在“日期”列中有一些空白值，但是一旦我先删除了这些行，宏就起作用了。我构建了一个单独的宏来删除这些行，但是当我将它添加到宏的开头时，它无法正常工作。有什么想法吗？ Rows("1:1").Select Selection.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase: =False, SearchFormat:=False).Activate ActiveCell.EntireColumn.Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete
你能提供一些测试工作簿（即使用dropbox.com）吗？因为对我来说代码完美运行
顺便说一句，您是否将ThisWorkbook.Worksheets("Sheet1") 行中的工作表名称更改为适合您的名称？

【解决方案2】：

按照这个经过测试的代码，使用最后一个单元格的 7 列。作者：RCC66

Sub Auto_Open()

' Order by
    Dim LastRow As Integer

    With ActiveSheet
        intLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "Q3:Q" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "L3:L" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "O3:O" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "J3:J" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "B3:B" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "H3:H" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    ActiveWorkbook.Worksheets("Invoices").Sort.SortFields.Add Key:=Range( _
        "E3:e" & intLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    With ActiveWorkbook.Worksheets("Invoices").Sort
        .SetRange Range("A1:R" & intLastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

【讨论】：