在Excel中sorting公式

我有这样的数据:

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

…但是我希望在同一个Excel工作表上有两个“副本”,第一个sorting在第一列,如下所示:

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

…第二个表格将是相同的数据,但在第二列sorting,如下所示:

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

…但问题是,我不想在Excel中使用实际的“sorting”function! 这听起来很疯狂,但我有一个更大的应用程序,手动sorting将是非常繁琐的。 如果可能的话,我想有一个自动执行此操作的公式,但我也可以使用Excel VBAmacros。 有任何想法吗?

好的,这是我提出的解决scheme。 也许有一个更优雅的方式,请让我知道! 多谢你们 :)

在这里输入图像描述

如果你有很多的表单,VBA可能是要走的路。 下面的代码是做到这一点的一种方法。 它循环遍历工作簿中的所有工作 ,并通过在SortBy1SortBy2定义的variables对每个表进行sorting(假定工作表只包含一个A1开头的 )。

它将通过SortBy2对表进行SortBy2 ,将其复制到原始表下方,然后再通过SortBy2对原始表进行sorting。 只要你想sorting的variables在整个工作簿中都被命名为相同,就应该这样工作。

 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 

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


MOREFUNC ADDON

  • Morefunc Addon是一个包含66个新工作表函数的免费库。
  • 这里是一些信息(由原作者)
  • 这里是我发现的最后一个工作下载链接
  • 这里是一个很好的安装步行video

转到Google工作表,只需使用SORT()