VBA Excel多列排序

我有一个Excel表格，我希望在保存文件之前，表格“CR”中有值的所有行（标题行除外）（如果可能，不包括公式（a列包含公式）），首先按B列（名称=团队），然后按C列（名称=建筑），最后按d列（名称=日期）排序

我是VBA的绝对高手，所以我正在尝试我在论坛上找到的东西，并根据我的需要进行修改。通过四处搜索，我在Excel VBA对象“工作簿”中尝试了以下代码，但它给出了一个错误：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Setup column names
Col1name = "SECTION"
Col2name = "BATIMENT"
Col3name = "DATE_MAJ"

'Find cols
For Each cell In Range("A1:" & Range("A1").End(xlToRight).Address)
    If cell.Value = Col1name Then
        Col1 = cell.Column
    End If
    If cell.Value = Col2name Then
        Col2 = cell.Column
    End If
    If cell.Value = Col3name Then
        Col3 = cell.Column
    End If

Next

'Below two line:- if they are blank e.g. column not found it will error so a small bit of error handling 
If Col1 = "" Then Exit Sub
If Col2 = "" Then Exit Sub
If Col3 = "" Then Exit Sub

'Find last row - dynamic part
lastrow = ActiveSheet.Range("A100000").End(xlUp).Row

'Convert col numer to name
Col1 = Split(Cells(1, Col1).Address(True, False), "$")
Col2 = Split(Cells(1, Col2).Address(True, False), "$")
Col3 = Split(Cells(1, Col3).Address(True, False), "$")

'Sort
With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(Col1(0) & "2:" & Col1(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range(Col2(0) & "2:" & Col2(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range(Col3(0) & "2:" & Col3(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    .SetRange Range("A1:K" & lastrow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

如果能帮我把代码弄好，我将不胜感激。下面是Excel文件的链接（我取出了上面的代码，因为它不起作用）

---

由于您只有三个排序列，您可能希望使用

范围

对象的方法，而不是

工作表

对象的同名方法

此外，假设列标题与链接的excel文件一致，您可以尝试以下操作：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim col1 As Range, col2 As Range, col3 As Range
    Dim lastRow As Long

    'Setup column names
    Const col1Name As String = "SECTION"
    Const col2Name As String = "BUILDING" '"BATIMENT"
    Const col3Name As String = "DATE UPDATE" '"DATE_MAJ"

    With Worksheets("CR") '<--| reference your worksheet
        'Find last row - dynamic part
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row ' <--|find its column "A" last not empty row index
        'Find cols
        With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) '<--|reference its row 1 cells from column 1 to last not empty one and search for sorting columns whose header matches above set column names
            If Not TryGetColumnIndex(.Cells, col1Name, col1) Then Exit Sub '<--| if 1st sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col2Name, col2) Then Exit Sub '<--| if 2nd sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col3Name, col3) Then Exit Sub '<--| if 3rd sorting column not found then exit sub
            .Resize(lastRow).Sort _
                            key1:=col1, order1:=xlAscending, DataOption1:=xlSortNormal, _
                            key2:=col2, order2:=xlAscending, DataOption2:=xlSortNormal, _
                            key3:=col3, order3:=xlAscending, DataOption3:=xlSortNormal, _
                            Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
        End With
    End With
End Sub

Function TryGetColumnIndex(rng As Range, colName As String, col As Range) As Boolean
    Set col = rng.Find(What:=colName, LookIn:=xlValues, LookAt:=xlWhole)
    TryGetColumnIndex = Not col Is Nothing
End Function

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
调暗col1作为范围，col2作为范围，col3作为范围
最后一排一样长
'设置列名
Const col1Name As String=“SECTION”
Const col2Name As String=“BUILDING”'“BATIMENT”
Const col3Name As String=“DATE UPDATE”'“DATE_MAJ”
对于工作表（“CR”）”由于您只有三个排序列，您可能希望使用
Range
object的方法，而不是
Worksheet
object的同名方法

此外，假设列标题与链接的excel文件一致，您可以尝试以下操作：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim col1 As Range, col2 As Range, col3 As Range
    Dim lastRow As Long

    'Setup column names
    Const col1Name As String = "SECTION"
    Const col2Name As String = "BUILDING" '"BATIMENT"
    Const col3Name As String = "DATE UPDATE" '"DATE_MAJ"

    With Worksheets("CR") '<--| reference your worksheet
        'Find last row - dynamic part
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row ' <--|find its column "A" last not empty row index
        'Find cols
        With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) '<--|reference its row 1 cells from column 1 to last not empty one and search for sorting columns whose header matches above set column names
            If Not TryGetColumnIndex(.Cells, col1Name, col1) Then Exit Sub '<--| if 1st sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col2Name, col2) Then Exit Sub '<--| if 2nd sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col3Name, col3) Then Exit Sub '<--| if 3rd sorting column not found then exit sub
            .Resize(lastRow).Sort _
                            key1:=col1, order1:=xlAscending, DataOption1:=xlSortNormal, _
                            key2:=col2, order2:=xlAscending, DataOption2:=xlSortNormal, _
                            key3:=col3, order3:=xlAscending, DataOption3:=xlSortNormal, _
                            Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
        End With
    End With
End Sub

Function TryGetColumnIndex(rng As Range, colName As String, col As Range) As Boolean
    Set col = rng.Find(What:=colName, LookIn:=xlValues, LookAt:=xlWhole)
    TryGetColumnIndex = Not col Is Nothing
End Function

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
调暗col1作为范围，col2作为范围，col3作为范围
最后一排一样长
'设置列名
Const col1Name As String=“SECTION”
Const col2Name As String=“BUILDING”'“BATIMENT”
Const col3Name As String=“DATE UPDATE”'“DATE_MAJ”
对于工作表（“CR”），您遇到了什么错误？是哪条线扔的？此外，您链接的示例没有任何列标题以“BATIMENT”或“DATE_MAJ”命名。列C和D的列名为“BATIMENT”和“DATE_MAJ”；它们的标题实际上是“BUILDING”和“dateupdate”。这有关系吗？我得到的错误是“Compile error:variable not defined”（编译错误：未定义变量），并且在VBA代码中选择了“Col1name”。如果您在没有名称的范围内搜索名称（比如“bation”），那么您将找不到它！至于错误：您的模块顶部是否有
选项显式
语句？您遇到了什么错误？是哪条线扔的？此外，您链接的示例没有任何列标题以“BATIMENT”或“DATE_MAJ”命名。列C和D的列名为“BATIMENT”和“DATE_MAJ”；它们的标题实际上是“BUILDING”和“dateupdate”。这有关系吗？我得到的错误是“Compile error:variable not defined”（编译错误：未定义变量），并且在VBA代码中选择了“Col1name”。如果您在没有名称的范围内搜索名称（比如“bation”），那么您将找不到它！至于错误：在模块顶部是否有一个
Option Explicit
语句？谢谢，但该代码给出了以下内容：运行时错误“438”：对象不支持此属性或方法。单击“调试”时，将突出显示以下行：lastRow=.Cells（.Rows.Count，1）.End（xlUp）.rowrow“我将代码粘贴到对象“ThisWorkbook”中。”。我想这是对的？@Antoon，你挺过来了吗？非常感谢！！！在“.Resize（lastRow.Sort）”之后的行中仍然有一个小的输入错误：将col2更改为col1，现在它就像一个符咒一样工作@Anton，如果要在排序后
Autofit
行，请在
.Resize（lastRow）.rows.Autofit
语句之后添加
.Resize（lastRow）.Sort…
语句谢谢，但该代码给出以下信息：运行时错误“438”：对象不支持此属性或方法。单击“调试”时，将突出显示以下行：lastRow=.Cells（.Rows.Count，1）.End（xlUp）.rowrow“我将代码粘贴到对象“ThisWorkbook”中。”。我想这是对的？@Antoon，你挺过来了吗？非常感谢！！！在“.Resize（lastRow.Sort）”之后的行中仍然有一个小的输入错误：将col2更改为col1，现在它就像一个符咒一样工作@Anton，如果要在排序后
Autofit
行，请在
.Resize（lastRow）.rows.Autofit
语句之后添加
.Resize（lastRow）.Sort…
语句