使用VBA遍歷每一列并從大到小排序

我有一個由 excel 中的數字組成的資料集，其中包含 300 行和 2677 列，我希望遍歷每一列并將它們從大到小排序。

我試圖修改下面的代碼，但找不到一種方法來遍歷每一列并按從大到小的排序，有人能幫我嗎？

    Range("I5").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add2 Key:=Range("I5:I312" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("I5:I312")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

uj5u.com熱心網友回復：

對列進行降序排序

• 據推測，該資料在小區開始I5在Sheet3包含此代碼（作業簿的ThisWorkbook）。

Option Explicit

Sub SortColumnsDescending()
' Needs the 'RefColumn' function.
    Const ProcTitle As String = "Sort Columns Descending"
    
    Const wsName As String = "Sheet3"
    Const FirstCellAddress As String = "I5"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
    Dim lCell As Range
    Set lCell = ws.Cells(fCell.Row, ws.Columns.Count).End(xlToLeft)
    If lCell.Column < fCell.Column Then Exit Sub ' no data in header row range
    
    Dim hrrg As Range: Set hrrg = ws.Range(fCell, lCell) ' Header Row Range
    Dim frrg As Range: Set frrg = hrrg.Offset(1) ' Data First Row Range
    
    Application.ScreenUpdating = False
    
    Dim crg As Range ' Current Column Range
    Dim frCell As Range ' Current First Row Cell
    
    For Each frCell In frrg.Cells
        Set crg = RefColumn(frCell)
        If Not crg Is Nothing Then
            crg.Sort Key1:=crg, Order1:=xlDescending, Header:=xlNo
            Set crg = Nothing
        'Else ' no data in column range
        End If
    Next frCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Columns sorted.", vbInformation, ProcTitle
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range from the first cell
'               of a range ('FirstCell') to the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    If FirstCell Is Nothing Then Exit Function
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row   1)
    End With

End Function

uj5u.com熱心網友回復：

請嘗試下一個代碼。無需選擇任何東西，選擇只消耗Excel資源，不會帶來任何好處：

Sub SortColumns()
 Dim sh As Worksheet, lastCol As Long, i As Long
 Set sh = Worksheets("Sheet3")
 lastCol = 2677 'it can be calculated, if all existing columns should be sorted
 With Application 'a little optimization
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
 End With
 For i = 1 To lastCol
    sh.Range(sh.cells(5, i), sh.cells(5, i).End(xlDown)).Sort key1:=sh.cells(5, i), _
                  order1:=xlDescending, Header:=xlGuess, Orientation:=xlSortColumns
 Next i
 With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
 End With
End Sub

上面的代碼假設排序的范圍中不存在空單元格。如果它們可能存在，則應以不同的方式計算要排序的范圍的最后一行。我保留了你的計算方式，但沒有選擇......

標籤：擅长 vba 循环 排序

上一篇：MSXML總是向元素添加命名空間

下一篇：在特定作業表上運行的命令按鈕