Question

我有一个Excel表格，我希望Sheet“CR”中包含值的所有行（标题行除外）（如果可能，排除公式（列A包含公式））首先按在保存文件之前，列B（name = TEAM），然后是C（name = BUILDING），最后是D（name = DATE_MAJ）。

我是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文件的链接（我拿出上面的代码，因为它不起作用）。

Dropbox link to Excel file

Answer 1

由于您只有三个排序列，因此您可能希望使用Range对象的Sort()方法，而不是Worksheet对象的同名方法

此外，根据链接的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

多列VBA Excel排序

1 个答案: