首页 > 解决方案 > 使用底部而不是顶部的空文本单元格自动排序

问题描述

我有一个从另一张表中提取的名字名单,然后使用宏自动排序。

当公式没有返回值“空文本”时,它被推到顶部。如何在返回排序值升序的同时将其推到底部?

Public Sub Worksheet_Activate()
    Sheet6.Unprotect Password:="xxxxxxx"
     
    Range("A1:F151").Sort Key1:=Range("A1"), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
           
    Sheet6.Protect Password:="xxxxxxx", _
      DrawingObjects:=True, Contents:=True, Scenarios:=True
      
End Sub

标签: excelvbasorting

解决方案


升序排序:空白到底部

  • 取消注释Debug.Print以监控四个“阶段”的范围。

编码

Option Explicit

Private Sub Worksheet_Activate()
    
    Application.ScreenUpdating = False
    
    Me.Unprotect Password:="xxxxxx"
    
    ' Define constants.
    
    Const Cols As String = "A:F"
    Const FirstRow As Long = 1
    Const CriteriaColumn As Long = 1
    
    ' Define Source Range (There are many ways).
    
    ' Define Processing Range (from defined first row to bottom-most row).
    With Columns(Cols).Resize(Rows.Count - FirstRow + 1).Offset(FirstRow - 1)
        ' Validate Criteria Column.
        If .Columns.Count < CriteriaColumn Then
            Exit Sub
        End If
        ' Define Source First Cell Range ('fCell').
        Dim fCell As Range
        Set fCell = .Cells(1)
        'Debug.Print fCell.Address
        ' Define Source Range ('rng').
        Dim rng As Range
        Set rng = Intersect(fCell.CurrentRegion, .Cells)
        'Debug.Print rng.Address
    End With
    
    ' Sort Source Range.
    
    ' Sort descending.
    rng.Sort Key1:=fCell.Offset(, CriteriaColumn - 1), _
             Order1:=xlDescending, _
             Header:=xlYes
    ' Define Last Non-Blank Cell in Criteria Column ('lCell').
    Dim lCell As Range
    Set lCell = rng.Columns(CriteriaColumn).Find(What:="*", _
                                             LookIn:=xlValues, _
                                             SearchDirection:=xlPrevious)
    'Debug.Print lCell.Address
    ' Define Non-Blank Range ('rng').
    Set rng = rng.Resize(lCell.Row - rng.Row + 1)
    'Debug.Print rng.Address
    ' Sort Non-Blank Range ascending.
    rng.Sort Key1:=fCell.Offset(, CriteriaColumn - 1), _
             Order1:=xlAscending, _
             Header:=xlYes

    Me.Protect Password:="xxxxxx", _
      DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

推荐阅读