操作方法
Sub 分类汇总() Application.ScreenUpdating = False Columns("A:D").Select Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True '将选中的区域进行分类汇总 Columns("B:B").Select Selection.Copy Range("A1").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False '将B列的格式粘贴到A列 Range("A2:A108").Select Selection.SpecialCells(xlCellTypeBlanks).Select '在指定的区域中选中空白类型单元格 With Selection .HorizontalAlignment = xlCenter '水平对齐 .VerticalAlignment = xlCenter '垂直对齐 .WrapText = True '文本框 .Orientation = 0 '方向 .AddIndent = False '是否缩进 .IndentLevel = 0 '缩进量 .ShrinkToFit = False '收缩到合适的大小 .ReadingOrder = xlContext '阅读顺序 .MergeCells = False '合并单元格 End With Selection.Merge Columns("A:A").Select Selection.Copy Range("B1").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False '将A列的格式粘贴到B列 Columns("A:B").Select Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Columns("A:A").Select Selection.Delete Shift:=xlToLeft Application.ScreenUpdating = True End Sub
运行宏，结果就如下图，非常方便。