Excel 2013:使用VBA基于第一行值对列进行排序

时间:2016-04-16 08:16:39

标签: excel vba excel-vba sorting

我想实现一个Excel宏,它将列“C”中的所有列排序到包含数据的最后一列(列A和B不受影响)。

列应根据第一行的单元格值(即字符串)从A-> Z中排序。

到目前为止,我想出了以下代码,我不太喜欢它,因为它包含Sort范围的硬编码数字,使得代码不够强大。

Sub SortAllColumns()
    Application.ScreenUpdating = False

'Sort columns
    With ActiveWorkbook.Worksheets("mySheet").Sort
        .SetRange Range("C1:ZZ1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .Apply
    End With

    Application.ScreenUpdating = True
End Sub

搜索互联网时,可能会发现大量建议获取最后使用的列或行。然而,他们中的大多数会比我预期的更加夸大代码。

我不是VBA专家,如果有人可以提出一个如何以优雅和有效的方式解决这个问题的建议,那就太棒了。

如果这很重要:我们绝对不会有超过1000行和1000列。

任何建议都非常感谢。

2 个答案:

答案 0 :(得分:1)

感谢@SiddharthRout的建议和修订,我得到了这个:

Sub SortAllColumns()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim LastColumnLetter As String

    Set ws = ThisWorkbook.Sheets("mySheet")

    'Get range
    With ws
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        LastColumnLetter = Split(.Cells(, LastColumn).Address, "$")(1)

       'Sort columns
        Range("C1:" & LastColumnLetter & LastRow).Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("C1:" & LastColumnLetter & 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        With .Sort
            .SetRange ws.Range("C1:" & LastColumnLetter & LastRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlLeftToRight
            .Apply
        End With
    End With

    Application.ScreenUpdating = True
End Sub

答案 1 :(得分:1)

<强>编辑:

  • 更改了临时工作表添加声明,使其始终作为最后一个
  • 相应地修改了删除声明

您是否需要通过移动列来对列进行排序,以便从左到右排序标题,然后尝试此代码

Option Explicit

Sub main()
Dim lastCol As Long

With Sheets("mySheet")
    lastCol = .cells(1, .Columns.Count).End(xlToLeft).Column
    Call OrderColumns(Range(.Columns(3), Columns(lastCol)))
End With

End Sub


Sub OrderColumns(columnsRng As Range)
Dim LastRow As Long

With columnsRng
    LastRow = GetColumnsLastRow(columnsRng)
    With .Resize(LastRow)
        .Copy

        With Worksheets.Add(after:=Worksheets(Worksheets.Count)).cells(1, 1).Resize(.Columns.Count, .Rows.Count) 'this will add a "helper" sheet: it'll be removed
            .PasteSpecial Paste:=xlPasteAll, Transpose:=True
            .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo 
            .Copy
        End With
        .PasteSpecial Paste:=xlPasteAll, Transpose:=True

        Application.DisplayAlerts = False: Worksheets(Worksheets.Count).Delete: Application.DisplayAlerts = True 'remove the "helper" sheet (it's the (n-1)th sheet)

    End With

End With

End Sub


Function GetColumnsLastRow(rng As Range) As Long
Dim i As Long
'gets last row of the given columns range

GetColumnsLastRow = -1
With rng
    For i = 1 To .Columns.Count
        GetColumnsLastRow = WorksheetFunction.Max(GetColumnsLastRow, .Parent.cells(.Parent.Rows.Count, .Columns(i).Column).End(xlUp).row)
    Next i
End With
End Function

它使用了一个“帮助者”临时(它被末尾删除)表。