基于字符串的自定义排序

Question

我有一列，其中有一些像这样的值，也有一些空白行，

Mr. & Mrs. X-Large
Mr. & Mrs. Large
Mr. & Mrs. Small
Mr. & Mrs. X-Large 
Mr. & Mrs. Small
Mr. & Mrs. X-Large
Mr. & Mrs. Large
Mr. & Mrs. X-Large
Mr. & Mrs. Large
Mr. & Mrs. Small
Mr. & Mrs. Medium
Mr. & Mrs. 2XL
Mr. & Mrs. 2XL
Mr. & Mrs. Large
Mr. & Mrs. Medium
Mr. & Mrs. Medium
Mr. & Mrs. Large

我想自定义对工作表的排序方式，其中先出现“小”，然后是“中”，“大”，“ X大”等等。我正在寻找一些可以在这里使用的宏。在这里感谢您的帮助。谢谢！

更新07/07-所以我尝试使用Macro来解决它，这是我遵循的， 1.在我的excel中，我有3个工作表，仪表板，常规样本工作表和一个附加的隐藏工作表-Sheet1 2.在隐藏的工作表（Sheet1）上，我创建了一个额外的列，为数值（如Mr.＆Mrs. Small-1，Mr.＆Mrs. Medium-2，2，Mrs. and Mrs. Large-3等）分配数值。 2.使用以下宏在仪表板页面上的表单控件上进行排序

Sub Button2_Click()
Call PopulateSheet1
Call Sort
Call PopulateRegularSampleSheet
Application.CutCopyMode = False
End Sub

以下功能将数据从常规工作表复制到隐藏工作表1

Sub PopulateSheet1()
Worksheets("Regular Sample Sheet").Range("A1:BB10000").Copy
Worksheets("Sheet1").Range("A1:BB10000").PasteSpecial (xlPasteValues)
End Sub

以下功能对隐藏工作表中的数据进行排序

Sub Sort()
Worksheets("Sheet1").Range("A1:BC10000").Sort 
Key1:=Worksheets("Sheet1").Range("BC1"), order1:=xlAscending, Header:=xlYes
End Sub

以下内容将数据从隐藏工作表复制回常规工作表

Sub PopulateRegularSampleSheet()
Worksheets("Sheet1").Range("A2:BB10000").Copy
Worksheets("Regular Sample Sheet").Range("A2:BB10000").PasteSpecial 
(xlPasteValues)
End Sub

因此，在运行宏之后，“常规表”和隐藏表“ Sheet1”都保持选中状态。所以我的问题是在宏运行后如何使其不被选中。

Answer 1

正如一些人在评论中建议的那样，请使用“自定义排序”。也就是说，如果内置功能支持您要执行的操作，通常您不应进入宏。

这是捕获如何指定自定义排序顺序（而不是字母顺序）的图像：

如果您确实想通过宏进行排序，这是我记录的一个简单宏，它具有相同的功能，但是在VBA代码中：

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("A1:A4") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Small,Medium,Large", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:A4")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Answer 2

我会尝试：

Option Explicit
Sub specialSort()
    Dim rSrc As Range, rScratch As Range, C As Range
    Dim wsSrc As Worksheet, wsScratch As Worksheet
    Dim V As Variant

Set wsSrc = Worksheets("sheet1")
    Set rSrc = wsSrc.Cells(1, 1).CurrentRegion

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wsScratch = Worksheets.Add
    Set rScratch = wsScratch.Cells(1, 1)

rSrc.Copy rScratch
Set rScratch = rScratch.CurrentRegion
For Each C In rScratch
    C.Offset(0, 1).Value = Split(C)(UBound(Split(C)))
Next C

Set rScratch = rScratch.CurrentRegion
With wsScratch.Sort
    .SortFields.Clear
    .SortFields.Add Key:=rScratch.Columns(2), _
    SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:="Small,Medium,Large,X-Large,2XL", _
        DataOption:=xlSortNormal
    .SetRange rScratch
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .Apply
End With

rScratch.Columns(1).Copy rSrc

wsScratch.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

• 我们使用临时表，完成后将其删除。

• 复制源数据-如果有公式，则可以粘贴特殊值

• 为尺寸创建一个额外的列

• 按大小列排序。

• 将第一列复制回原始工作表。

• 删除草稿纸