首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >在Excel中使用VBA sub进行升序/降序排序

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

Stack Overflow用户
提问于 2019-03-18 06:16:08
回答 1查看 640关注 0票数 0

我想对Excel中的大量数据进行排序。它应该在每次点击时在升序和降序之间切换。

我发现这个问题在下一个线程中得到了解决:sort ascending/descending vba excel

但是我想在代码中做一些修改。我想使用我单击的当前列(标题)进行排序。我不知道这是否可能,只使用一个宏并将单元格发送到我调用事件的位置。

下面是我使用的代码:

工作表(我在其中调用Sub):

代码语言:javascript
复制
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:

代码语言:javascript
复制
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
    Else
       xlSort = xlDescending
    End If

    Set dataRange = Range("A2:C" & LastRow)
    Set campoOrden = Order

    dataRange.Sort key1:=fieldOrder, order1:=xlSort, Header:=xlYes

End Sub
EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2019-03-18 09:07:08

根据选定内容更改进行排序

工作表模块,如Sheet1

代码语言:javascript
复制
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

标准模块,如Module1

代码语言:javascript
复制
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
        Else
            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)
        End With
    End With
    ' Sort Sort Range.
    rngS.Sort Key1:=Target, Order1:=xlSort, Header:=xlYes

 End Sub
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/55212491

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档