4列でソートする

Question

私は以下のシートとコードを用意しています。 F：私が欲しいのは

1. まず列F、
2. その後、列B、
3. 次に列D、
4. と最後の列E

列Aのデータをソートすることですしたがって、私はデータセット全体に対して上記のソート（F、B、D、E）を行う必要があります。

また、1行目に上記のデータがいくつかあるため、「全体」列は使用できませんが、特定の「データフィールド」を並べ替える必要があります。

上記のランキングが適用されるように、4番目の並べ替えを追加する方法をお勧めします。

ありがとうございます！

Private Sub Remove_Dubs_IndBB() 

Dim i As Long 
Dim data As Integer 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count 

Call Sum_IF 
SendKeys ("{ESC}") 

With Range("A2", Range("F" & Rows.Count).End(xlUp)) 

.Sort Key1:=Cells(1, 6), Order1:=xlDescending, _ 
Header:=xlNo 

    For i = 1 To data 
     If (VBA.Date - Cells(i, 4))/365 > 5 Then 
      Range(Cells(i, 1), Cells(i, 6)).ClearContents 
     End If 
     If (Cells(i, 5) - VBA.Date)/365 < 1.25 Then 
      Range(Cells(i, 1), Cells(i, 6)).ClearContents 
     End If 
    Next i 

Range("A2", Range("F" & Rows.Count).End(xlUp).Address).Select 
    Selection.Sort Key1:=Columns(6), Order1:=xlDescending, _ 
    Header:=xlNo 

    Selection.Sort Key1:=Columns(2), Order1:=xlDescending _ 
    , Key2:=Columns(4), Order2:=xlDescending _ 
    , Key3:=Columns(5), Order3:=xlDescending _ 
    , Header:=xlNo 


Range("A2", Range("F" & Rows.Count).End(xlUp)).RemoveDuplicates (3),  Header:=xlNo 

End With 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Sub Sum_IF() 

Dim i As Long 
Dim data As Integer 

data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count 

With Range("A2", Range("F" & data)) 
For i = 1 To data 
    .Cells(i, 6).FormulaR1C1 = "=SUMIF(R2C3:R[" & data & "]C3, RC[-3], R2C2:R[" & data & "]C2)" 
    .Cells(i, 6).Copy 
    .Cells(i, 6).PasteSpecial xlPasteValues 
Next i 
End With 

End Sub 

Answer 1

OK、そう答えは、すべてが同じ値を持っていることをFでの範囲について[列Fでソート残りの3つの基準によってデータをソートすることです。

次のSubは、4つの列にデータをソートします

Sub SortFourCols() 
    Dim RowCounter As Long, RowDepth As Long, i As Long 
    Dim ws As Worksheet: Set ws = Worksheets("Sheet1") 
    Dim DataRows As Long: DataRows = Range("A1", Range("A" & Rows.Count).End(xlUp)).Count 
    Dim MatchRange As Range 

    ' F,B,D,E 
    With ws.Sort 
     .Header = xlNo 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlAscending 
     .SetRange Range(Cells(2, 1), Cells(DataRows, 6)) 
     .Apply 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("B:B"), Order:=xlAscending 
     .SortFields.Add Key:=Range("D:D"), Order:=xlAscending 
     .SortFields.Add Key:=Range("E:E"), Order:=xlAscending 
    End With 
    Set MatchRange = ws.Range(Cells(2, 6), Cells(DataRows, 6)) 
    With ws 
     For i = 2 To DataRows 
      RowDepth = Application.WorksheetFunction.CountIf(MatchRange, .Cells(i, 6).Value) 
      If RowDepth > 1 Then 
       With .Sort 
        .SetRange Range(Cells(i, 1), Cells(i + RowDepth - 1, 6)) 
        .Apply 
       End With 
      End If 
      i = i + RowDepth - 1 
      If i > DataRows Then Exit For 
     Next i 
    End With 
End Sub 

********* ********* EDITどうやら

は、使用することができます3つ以上のキー（ワークシートのソートオプションを設定し、範囲でソートすることとの違いは、ソートの範囲を使用する場合と違いがあります）。 Officeのバージョンがこれに相違があるかどうかわかりません。

Sub SortFourCols() 
    Dim ws As Worksheet: Set ws = Worksheets("Sheet1") 
    Dim DataRows As Long: DataRows = ws.Range("A1", Range("A" & Rows.Count).End(xlUp)).Count 

    ' F,B,D,E 
    With ws.Sort 
     .Header = xlYes 
     .SortFields.Clear 
     .SetRange Range(Cells(1, 1), Cells(DataRows, 6)) 
     .SortFields.Add Key:=Range("F:F"), Order:=xlAscending 
     .SortFields.Add Key:=Range("B:B"), Order:=xlAscending 
     .SortFields.Add Key:=Range("D:D"), Order:=xlAscending 
     .SortFields.Add Key:=Range("E:E"), Order:=xlAscending 
     .Apply 
     .SortFields.Clear 
    End With 
End Sub