Excel中的排序公式

Question

我有这样的数据：

bear        94
cat         25
alligator   53
impala      55
elk         56
fox         47
dog         13
gecko       18
jaguar      32
hound       59

...但我想在同一张 Excel 工作表上拥有该表的两个“副本”，第一个排序在第一列上，例如：

alligator   53
bear        94
cat         25
dog         13
elk         56
fox         47
gecko       18
hound       59
impala      55
jaguar      32

...第二个表将再次是相同的数据，但在第二列上排序，如下所示：

bear        94
hound       59
elk         56
impala      55
alligator   53
fox         47
jaguar      32
cat         25
gecko       18
dog         13

...但问题是我不希望必须在 excel 中使用实际的“排序”功能！这听起来可能很疯狂，但我有一个更大的应用程序，手动排序会非常乏味。如果可能的话，我想要一个自动执行此操作的公式，但我也可以使用 excel-VBA 宏。有什么想法吗？

Answer 1

好的，这是我想出的解决方案。也许有更优雅的方式，请告诉我！谢谢大家:)

Answer 2

如果您有很多工作表，VBA 可能是要走的路。以下代码是执行此操作的一种方法。它遍历工作簿中的所有工作表，并根据您在SortBy1 和@987654323 中定义的变量对每个表进行排序（假设工作表仅包含从单元格A1 开始的一个表） @。

它将按SortBy2 对表格进行排序，将其复制到原始表格下方，然后再次按SortBy1 对原始表格进行排序。只要您要排序的变量在整个工作簿中都命名相同，这应该可以工作。

Option Explicit

Sub SortAndCopy()
    Dim ws As Worksheet
    Dim DataRng As Range
    Dim SortRng1 As Range, SortRng2 As Range
    Dim nr As Integer, nc As Integer, i As Integer
    Dim DataArr As Variant
    Dim SortBy1 As String, SortBy2 As String
    Dim nBelowTable As Integer
    Dim HeaderFound As Integer

    SortBy1 = "Animal"  '<~~ Define the first variable to sort by
    SortBy2 = "Count"   '<~~ Define the second variable to sort by
    nBelowTable = 5     '<~~ Defines how far below the original table you want to place a copy

    Application.ScreenUpdating = False

    'Loops through each individual sheets
    For Each ws In ActiveWorkbook.Sheets
        HeaderFound = 0
        'Determines data range
        nr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        nc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        Set DataRng = ws.Range("A1:" & ws.Cells(nr, nc).Address)

        'Determines ranges to sort by
        For i = 1 To nc Step 1
            If LCase(ws.Cells(1, i).Value) = LCase(SortBy1) Then
                Set SortRng1 = ws.Range(ws.Cells(1, i).Address & ":" & ws.Cells(nr, i).Address)
                HeaderFound = HeaderFound + 1
            End If
            If LCase(ws.Cells(1, i).Value) = LCase(SortBy2) Then
                Set SortRng2 = ws.Range(ws.Cells(1, i).Address & ":" & ws.Cells(nr, i).Address)
                HeaderFound = HeaderFound + 1
            End If
        Next i

        'Exit if header not found
        If Not HeaderFound = 2 Then
            MsgBox "One of the header variables could not be found in the sheet " & ws.Name & ". No further sheets will be processed!", vbCritical
            Exit Sub
        End If

        'Sorts table by SortBy2
        With ws.Sort.SortFields
            .Clear
            .Add Key:=SortRng2, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        With ws.Sort
            .SetRange DataRng
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        'Places copy of this table underneath the original
        ReDim DataArr(1 To nr, 1 To nc)
        DataArr = DataRng
        ws.Range(ws.Cells(nr + nBelowTable, 1).Address, ws.Cells(2 * nr + nBelowTable - 1, nc).Address) = DataArr

        'Sorts table by SortBy1
        With ws.Sort.SortFields
            .Clear
            .Add Key:=SortRng1, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        With ws.Sort
            .SetRange DataRng
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    Next ws

    Application.ScreenUpdating = False
End Sub

Answer 3

获取 Excel 的 MOREFUNC 插件并使用 VSORT()

---

更多功能插件

• Morefunc 插件是一个包含 66 个新工作表函数的免费库。
• HERE是一些信息（原作者）
• 这是我找到的最后一个工作 download link
• 这是一个很好的installation walk-through video

Answer 4

移动到 Google 工作表并简单地使用 SORT()