☰

如何对 Excel 中的多个表进行自定义排序？

tag-icon • tag-icon microsoft-excel sorting
如何对 Excel 中的多个表进行自定义排序？

我想根据这些选项对它们进行排序，对四十多个表逐一进行排序很累：

first, column "Point A": Largest to Smallest
then, column "Point B": Largest to Smallest
then, column "Point C": Largest to Smallest
then, column "Penalties": Smallest to Largest

我不介意每桌一个一个地做如果有一个选项可以复制这些排序选项，以便更快地完成排序，而不必手动选择每个表格的选项。此外，表格是水平分布的，因此每个标题不会在表格之间共享同一列。

编辑详细信息

这就是我的桌子的样子

这是我希望对每个表进行排序的方式，以便根据结果对它们进行排名

答案1

以下是对实现此目的的一种方法的简要描述。

对于此示例，其中一个表格位于单元格 D3。

首先，录制一个排序操作的宏。启动宏录制器，对表格进行排序，停止宏录制器。

您将获得类似这样的结果。

Sub Macro1()
'
' Macro1 Macro
'
    Range("D3").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("E4:E17") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("F4:F17") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("G4:G17") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("H4:H17") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D3:H17")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

接下来，编辑跨越多行的程序行。

Sub Macro1()
'
' Macro1 Macro
'
    Range("D3").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("E4:E17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("F4:F17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("G4:G17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("H4:H17"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D3:H17")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

其中五条线以 开头，ActiveWorkbook.Worksheets("Sheet1").Sort因此它们可以进入With块内。

Sub Macro1()
'
' Macro1 Macro
'
    Range("D3").Select
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("E4:E17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=Range("F4:F17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=Range("G4:G17"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=Range("H4:H17"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("D3:H17")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

接下来，编辑宏，使得所有范围都与单个单元格相关，本例中为 D3。

Sub Macro1()
'
' Macro1 Macro
'
    Dim rng As Range
    Dim tmp As Range
    Dim tabl As Range
    
    Set rng = Range("D3")
    Set tmp = Range(rng, rng.End(xlDown))
    Set tabl = Range(tmp, tmp.End(xlToRight))

'   tabl.Select                                 ' this is used during development to make sure that tabl is actually the desired range
    
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        
        .SortFields.Add2 Key:=rng.Offset(0, 1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=rng.Offset(0, 2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=rng.Offset(0, 3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=rng.Offset(0, 4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
        .SetRange tabl
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        
        .Apply
    End With
End Sub

接下来，在互联网上搜索在 Excel 表中搜索特定单元格值的函数。

这是一个例子。 https://www.thespreadsheetguru.com/the-code-vault/2014/4/21/find-all-instances-with-vba

修改示例函数以返回单元格范围，而不是仅突出显示单元格。

修改录制的宏以调用“搜索”功能来查找包含文本的所有单元格Player，该文本位于每个表格的左上角。

修改录制的宏以使用“搜索”功能返回的单元格列表，并在每个单元格处对表格进行排序。

这就是您所得到的。


Sub sortAll()
    
    Dim rng As Range
    Dim tmp As Range
    Dim tabl As Range
    Dim allData As Range
    
    Set allData = FindAll("Player")                     ' find all cells containing the text Player
    
    If Not allData Is Nothing Then
        For Each rng In allData                         ' reference the top left corner of each of the tables

            Set tmp = Range(rng, rng.End(xlDown))
            Set tabl = Range(tmp, tmp.End(xlToRight))
        
'           tabl.Select                                 ' only used during development to visually verify that tabl is actually the desired range
            
            With ActiveWorkbook.Worksheets("Sheet1").Sort
                .SortFields.Clear
                
                .SortFields.Add2 Key:=rng.Offset(0, 1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add2 Key:=rng.Offset(0, 2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add2 Key:=rng.Offset(0, 3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add2 Key:=rng.Offset(0, 4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
                .SetRange tabl
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                
                .Apply
            End With
        Next
    Else
        MsgBox "No values were found in this worksheet"
    End If
    
End Sub
'


' PURPOSE: Find all cells containing a specified values
' SOURCE: www.TheSpreadsheetGuru.com

Function FindAll(fnd As String) As Range
    
    Dim FirstFound As String
    Dim FoundCell As Range, rng As Range
    Dim myRange As Range, LastCell As Range
    
    Set myRange = ActiveSheet.UsedRange
'   myRange.Select                                              ' this is used during development to make sure that myRange is actually the desired range
    
    Set LastCell = myRange.Cells(myRange.Cells.Count)
    Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
    
    If Not FoundCell Is Nothing Then                            ' Test to see if anything was found
        FirstFound = FoundCell.Address
    Else
        Set FindAll = Nothing
        Exit Function
    End If
    
    Set rng = FoundCell
    
    
    Do Until FoundCell Is Nothing                               ' Loop until cycled through all unique finds
        Set FoundCell = myRange.FindNext(after:=FoundCell)      ' Find next cell with fnd value
        Set rng = Union(rng, FoundCell)                         ' Add found cell to rng range variable
        If FoundCell.Address = FirstFound Then Exit Do          ' Test to see if cycled through to first found cell
    Loop
    
    Set FindAll = rng                                           ' return range of cells containing find value
End Function
'

相关内容