按标题名称对列进行排序，但如果标题名称不存在，则按其他标题名称排序

Question

我有一些个人数据需要 VBA 按标题名称排序，但有时其中一个标题不存在，我需要它来跳过代码块并按不同的标题名称排序。另外，我只能弄清楚如何做三列而不是四列，所以如果有人能帮我解决这个问题，那就太棒了！

我需要它升序排序：

Grade, Teacher, Last Name, First Name -要么- Grade, Last Name, First Name

   Dim Fnd(1 To 3) As Range
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Grade", "Teacher", "Last Name")
   For i = 1 To 3
      Set Fnd(i) = Range("1:1").Find(Ary(i - 1), , , xlWhole, , , False, , False)
   Next i
   Range("A1").CurrentRegion.Sort _
   key1:=Fnd(1), order1:=xlAscending, _
   key2:=Fnd(2), order2:=xlAscending, _
   key3:=Fnd(3), order3:=xlAscending, _
   Header:=xlYes

Answer 1

这样的事情应该可以工作：

Dim SortColumns As Variant
SortColumns = Array("Grade", "Teacher", "Last Name", "First Name")  'define all columns to sort by

With ThisWorkbook.Worksheets("Sheet1")  'specify your sheet here
    .Sort.SortFields.Clear
    
    Dim RngFound As Range
    Dim SortColumn As Variant
    For Each SortColumn In SortColumns
        Set RngFound = Nothing
        Set RngFound = .Range("1:1").Find(SortColumn, , , xlWhole, , , False, , False)
        
        If Not RngFound Is Nothing Then  ' add to sortfields if header was found
            .Sort.SortFields.Add2 Key:=RngFound.EntireColumn, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End If
    Next SortColumn
    
    .Sort.SetRange .Range("A1").CurrentRegion
    .Sort.Header = xlYes
    .Sort.MatchCase = False
    .Sort.Orientation = xlTopToBottom
    .Sort.SortMethod = xlPinYin
    .Sort.Apply
End With

如果它们存在，它将按所有 4 个字段排序，而忽略不存在的字段。

Answer 2

Range.Sort 一次限制为 3 个键，但您可以多次排序并每次使用不同的列。您可以将它们以相反的顺序排列，因为最终的排序会覆盖之前的排序。

我会这样做：

Sub HeaderSort()
    Dim ws As Worksheet
        Set ws = ActiveSheet

    Dim HeaderLabels As Variant
    HeaderLabels = Array("Grade", "Teacher", "Last Name", "First Name")
    
    Dim HCols() As Range, i As Long
    ReDim HCols(LBound(HeaderLabels) To UBound(HeaderLabels))
    For i = LBound(HeaderLabels) To UBound(HeaderLabels)
        Set HCols(i) = ws.Rows(1).Find(HeaderLabels(i), , , xlWhole, , , False, , False)
    Next i
    
    If HCols(1) Is Nothing Then 'Teacher header not found
        ws.Range("A1").CurrentRegion.Sort _
            key1:=HCols(0), order1:=xlAscending, _
            key2:=HCols(2), order2:=xlAscending, _
            key3:=HCols(3), order3:=xlAscending, _
            Header:=xlYes
        
    Else 'All 4 headers found
        'Sort the 4th, least priority header first
        ws.Range("A1").CurrentRegion.Sort key1:=HCols(3), order1:=xlAscending, Header:=xlYes
        
        'Sort the other three
        ws.Range("A1").CurrentRegion.Sort _
            key1:=HCols(0), order1:=xlAscending, _
            key2:=HCols(1), order2:=xlAscending, _
            key3:=HCols(2), order3:=xlAscending, _
            Header:=xlYes
    End If
End Sub