VBA删除排序汇总

Sub Summary_data()
    ActiveWorkbook.Activate

  '方法一显示需求列
    'Union(Columns(1), Columns(3), Columns(5), Columns(6), Columns(9), Columns(10), 'Columns(11), Columns(12), Columns(13), Columns(14), Columns(15), Columns'("v:bc")).EntireColumn.Select
    'Selection.Delete Shift:=xlToLeft
    'Range("A1").Select

  '方法二删除不必要的列，显示需求列
    Dim a, b
     b = 0
     a = 1
    For a = a To 55 Step 0
      If Cells(1, a) = "Order number" Or Cells(1, a) = "Label code" Or Cells(1, a) = "Size" Or Cells(1, a) = "Quantity" Or _
        Cells(1, a) = "Data 8" Or Cells(1, a) = "Data 9" Or Cells(1, a) = "Data 10" Or Cells(1, a) = "Data 11" Or Cells(1, a) = "Data 12" Or Cells(1, a) = "Data 13" Then
        a = a + 1
      Else
        Columns(a).Select
        Selection.Delete Shift:=xlToLeft
     End If
    b = b + 1
     If b > 255 Then
       a = 300
     End If
    Next a

  '排序Num

    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A65536" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B2:B65536") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C65536") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1:J65536")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 '分类汇总
    Dim r As Integer: r = Range("a65536").End(xlUp).Row
    Dim rb As Integer: rb = r
    Dim i As Integer: i = r
    Do
    If Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
    Cells(rb + 1, 1).EntireRow.Insert Shift:=xlDown
     For m = i To rb
     Cells(rb + 1, 4).Value = Cells(rb + 1, 4).Value + Cells(m, 4).Value
     Cells(rb + 1, 4).Select
     Selection.Font.Bold = True
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
     Next m
     rb = i - 1
     End If
     i = i - 1
    Loop Until i = 1

    ActiveWorkbook.Save
End Sub