在Excel中使用VBA sub进行升序/降序排序开发者社区

link管理

链接快照平台

输入网页链接，自动生成快照
标签化管理网页链接

文章/答案/技术大牛

发布

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("A2:C2")) Is Nothing Then
            Call sort_table(Target)
        End If
    End If
End Sub

Sub sort_by_letters(Order As Range)
    Dim dataRange As Range
    Dim fieldOrder As Range
    Dim xlSort As XlSortOrder
    Dim LastRow As Long
    With ActiveSheet
        Set LastRow = .Cells(.Rows.Count, Order).End(xlUp).Row
    End With
    If (Order.Value > Range(Column(Order) & CStr(LastRow))) Then
        xlSort = xlAscending
       xlSort = xlDescending
    End If
    Set dataRange = Range("A2:C" & LastRow)
    Set campoOrden = Order
    dataRange.Sort key1:=fieldOrder, order1:=xlSort, Header:=xlYes
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range(strHeaders)) Is Nothing Then
            SortTable Target
        End If
    End If
End Sub

Public Const strHeaders As String = "A2:C2"
Sub SortTable(Target As Range)
    Dim LuCell As Range         ' Last Used Cell Range
    Dim rngS As Range           ' Sort Range
    Dim xlSort As XlSortOrder   ' Sort Order
    ' In Target Worksheet
    With Target.Worksheet
        ' Calculate last used cell in Target Column.
        Set LuCell = .Cells(.Rows.Count, Target.Column).End(xlUp)
        ' Check if value in first row below Headers in Target Column is greater
        ' than value in Last Used Cell Range.
        If Target.Offset(1) > LuCell Then
            xlSort = xlAscending
            xlSort = xlDescending
        End If
        ' In Headers Range
        With .Range(strHeaders)
            ' Calculate Sort Range.
            ' Create a reference to Sort Range.
            Set rngS = .Resize(LuCell.Row - .Row + 1)

问 在Excel中使用VBA sub进行升序/降序排序 EN

回答 1

Stack Overflow用户