用VBA进行分类汇总,特别是对数千行数据

bbhiox

Sub MYDH()
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("A1:F3001").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
        xlSortNormal, DataOption2:=xlSortNormal
    Range("A1:F3001").Select
    Range("A6").Activate
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(5), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("A2:B3001").Select
    Range("A3").Activate
    Selection.Copy
    Range("A3").Select
    ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, _
        IconFileName:=False
    Range("D2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("D2:D3001").Select
    Selection.Copy
    Range("D3").Select
    ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, _
        IconFileName:=False
    Range("F2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("F2:F3001").Select
    Selection.FillDown
    Range("D2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("D2:D3001").Select
    Selection.Copy
    Range("D3").Select
    ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, _
        IconFileName:=False
    Range("E:E").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    Selection.End(xlToLeft).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A2:A3001").Select
    Selection.Copy
    Range("A3").Select
    ActiveSheet.PasteSpecial Format:=1, Link:=1, DisplayAsIcon:=True, _
        IconFileName:=False
    Range("C1").Select
    Selection.AutoFilter Field:=3, Criteria1:="=*汇总*", Operator:=xlAnd
    Range("B5:C15").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("B5:C3100").Select
    Selection.NumberFormatLocal = "@"
    Range("B5").Select
End Sub

雄鹰

这个宏够长的，也不容易理解，能简化一下吗？

bbhiox

雄鹰 发表于 2012-2-20 19:21
这个宏够长的，也不容易理解，能简化一下吗？

不能,因为这里面用到了两次排序,两次各四列的选择性粘贴及两次分类汇总的代码,是一种月报表汇总的好方法

xpw6061

bbhiox 发表于 2012-2-20 19:28
不能,因为这里面用到了两次排序,两次各四列的选择性粘贴及两次分类汇总的代码,是一种月报表汇总的好方法

看样子是录制的吧,手工的不会有这么多冗长的代码

mtrzz

看到好长的遗传数据啊，表示呕吐

无聊的疯子

bbhiox 发表于 2012-2-20 19:28
不能,因为这里面用到了两次排序,两次各四列的选择性粘贴及两次分类汇总的代码,是一种月报表汇总的好方法

录的代码虽然好用,但是可简化的东西太多...

简化后的速度和效率都比你录的高....

fjmxwrs

bbhiox 发表于 2012-2-20 19:28
不能,因为这里面用到了两次排序,两次各四列的选择性粘贴及两次分类汇总的代码,是一种月报表汇总的好方法

何不把你的文件发上来，看你是需要怎么样的汇总，可能用SQL方便哦