Sorting formula in Excel
I have data that comes like this:
bear 94
cat 25
alligator 53
impala 55
elk 56
fox 47
dog 13
gecko 18
jaguar 32
hound 59
...but I would like to have two 'copies' of this table on the same Excel sheet, the first sorting on the first column, so like:
alligator 53
bear 94
cat 25
dog 13
elk 56
fox 47
gecko 18
hound 59
impala 55
jaguar 32
...and the second table would be again the same data, but sorting on the second column, like so:
bear 94
hound 59
elk 56
impala 55
alligator 53
fox 47
jaguar 32
cat 25
gecko 18
dog 13
...but the catch is that I don't want to have to use the actual 'sort' feature in excel! This may sound crazy, but I have a much larger application where manually sorting would be very tedious. If possible, I'd like to have a formula that does this automatically, but I could use an excel-VBA macro too. Any ideas?
OK, here's the solution I came up with. Maybe there's a more elegant way, please let me know! Thanks guys :)
If you got a lot of sheets, VBA may be the way to go. The following code is one way to do this. It loops through all the sheets in a workbook and sorts each table (assuming that the sheet only holds that one table which begins in cell A1 ) by the variables you define in SortBy1 and SortBy2 .
It will sort the table by SortBy2 , copy this beneath the original table and then sort the original table once more by SortBy1 . This should work as long as the variables you want to sort by are all named the same throughout the entire workbook.
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
Get MOREFUNC addon for Excel and use VSORT()
MOREFUNC ADDON
上一篇: 模仿Excel公式
下一篇: 在Excel中排序公式