sorting在四列

我有下面的表格和代码，目前不能正常工作。 我想要的是sorting

1. 第一列F，
2. 然后列B，
3. 然后列D，
4. 和E列

列A：F中的数据是一个数据集，因此我需要对整个数据集进行上面的sorting（F，B，D，E），而不是一个接一个排列。

另外，我在第一行有一些数据，所以我不能只取整列，而是需要在特定的“数据字段”中进行sorting。

请build议如何添加第四个sorting，以便应用上述排名。

谢谢！

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

好的，所以答案是按F列sorting，然后在F中的范围都有相同的值，按照剩下的三个标准对数据进行sorting。

以下Sub将对四列中的数据进行sorting

 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 

*********编辑*********

显然，你可以使用3个以上的键（区别可能是使用范围sortingvs设置工作表sorting选项，并在一个范围内使用它们）。 我不知道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