Excel VBA 多条件筛选及汇总统计 |
您所在的位置：网站首页 › excel怎么按条件分类汇总 › Excel VBA 多条件筛选及汇总统计 |
Excel VBA 多条件筛选及汇总统计
|
Excel VBA 多条件筛选 AdvancedFilter 汇总统计 sumproduct Range与Array交换
在日常工作中，面对Excel表格数据，为了分类进行统计，通过对表格数据筛选获取分类条目，再按条目实行汇总统计。要完成上面的工作，有人工操作和开发程序两种方法，本文通过一个有10000行数据的管线调查表，对不同管径、管材进行分类统计数量和长度，详细介绍人工操作和VBA程序开发这两种方法。 1、人工操作方法 1.1高级筛选Excel菜单：数据-高级 找开高级筛选对话框，如下图：
对话框中： 方式：将筛选 结果复制到其他位置 列表区域： 选择需要筛选 的区域 复制到：筛选结果粘贴位置（没有数据的空白区域） 选择不重复的记录：打钩 确定后得到的结果如下图
在P2单元格输入公式：=SUMPRODUCT((H:H=N2)*(I:I=O2),L:L) 在Q2单元格输入公式：=SUMPRODUCT((H:H=N2)*(I:I=O2)) 以此类推就可以计算出所有统计数据 2、VBA编程的方法虽然人工操作方法也很方便，但当我们利用程序处理一系列复杂工作的同时，要进行分类统计时，就无法使用人工操作方法了。所以还要讨论一下编程的方法。利用Excel的VBA二次开发编写程序，实现多条件筛选分类统计可以有多种方法，本文介绍宏表函数法的数组法二种方法。 2.1宏表函数法宏表函数法就是人工操作法录制宏，再对宏进行修改的方法。先做统计条目的筛选，对筛选结果进行排序，最后进行统计计算。代码如下： Sub 多条件筛选汇总统计() '利用宏表函数进行多条件筛选汇总统计用约：最大行设10000时0.1秒；用整列计算用时1.46秒 Dim 筛选数据区域 As Range Dim 复制区域 As Range Dim 总长 As Double Sheets("Sheet1").Select sngStart = Timer Set 筛选数据区域 = Range(Cells(1, 8), Cells(10000, 9)) Range(Cells(1, 14), Cells(30, 17)).Clear Set 目标区域 = Range(Cells(1, 14), Cells(1, 14)) 筛选数据区域.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=目标区域, Unique:=True '排序 With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Range("N2:N10000"), SortOn:=0, Order:=1, DataOption:=0 .SortFields.Add Key:=Range("O2:O10000"), SortOn:=0, Order:=1, DataOption:=0 .SetRange Range("N2:O10000") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin 'xlPinYin 表示按照首字母 排序 xlStroke 表示按每个字符的笔划数量排序。 .Apply End With i = 2 Do While Cells(i, 14) "" '利用宏表函数进行统计汇总 '预先能知道最大值时，条件式及统计项均使用最大值，可提高运算速度,用时 0.1 秒 Cells(i, 16) = "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15),R2C12:R20000C12)" Cells(i, 17) = "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15))" '预先不知道有多少行时，条件式及统计项均使用整列，会降低运算速度,用时 1.46 秒 'Cells(i, 16) = "=SUMPRODUCT((C8:C8=R" + Trim(str(i)) + "C14)*(C9:C9=R" + Trim(str(i)) + "C15),C12:C12)" 'Cells(i, 17) = "=SUMPRODUCT((C8:C8=R" + Trim(str(i)) + "C14)*(C9:C9=R" + Trim(str(i)) + "C15))" i = i + 1 Loop Cells(i, 16) = WorksheetFunction.Sum(Range(Cells(2, 16), Cells(i - 1, 16))) Cells(i, 17) = WorksheetFunction.Sum(Range(Cells(2, 17), Cells(i - 1, 17))) Debug.Print "耗费时间: " & Timer - sngStart Cells(1, 14) = "管径" Cells(1, 15) = "材质" Cells(1, 16) = "长度 m" Cells(1, 17) = "数量" Cells(i, 15) = "合计：" End Sub***利用宏表函数进行条件筛选的结果只能复制到工作表的区域内，无法利用变量接收。 理解宏表函数的语法对于宏表函数中动态地址的处理很重要，现在解释一下统计宏表函数的含义： "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15),R2C12:R20000C12)" 上面这句代码其实就是一段符合宏表函数语法的字符串，他等同于下面的字符串。 =SUMPRODUCT((R2C8:R20000C8=R2C14)*(R2C9:R20000C9=R2C15),R2C12:R20000C12) 红色部份是一个查询条件，意思是：第8列的第二行到20000行=第14列第2行，也应是说（管径=“400”） 绿色部份也是一个查询条件，意思是：第9列的第二行到20000行=第15列第2行，也应是说（管材=“塑料”） 黄色部份是需要统计的区域，这时是统计符合条件的管线长度。 统计数量时，不需要统计区域。 ***查询条件还可以更多，每个查询条件用小括号括起来，两个条件中间用“*”相连接。 ***查询条件中，把数值转化为字符串，一定要去除两端的空串，如Trim(str(i))，否则会出错。 2.2数组法数组法是纯编程的方法，创建动态数组，筛选出唯一的统计条目，同时进行数据的统计，最后对结果进行排序，使统计结果按排序的要求顺序输出，本例是升序。代码如下： Sub 综合数组分类统计() '数组排序用时约 0.14 秒，内置函数排序用时约 0.031秒。 Dim i As Integer, j As Integer Dim 总长 As Double, 数量 As Integer Dim str(3) Dim DataV(), js As Integer On Error Resume Next Sheets("Sheet1").Select Dim sngStart As Single: sngStart = Timer '筛选并排序：管径分类，材质分类 js = 0 i = 2 Do While Cells(i, 1) "" For j = 1 To js If Cells(i, 8) = DataV(0, j) And Cells(i, 9) = DataV(1, j) Then DataV(2, j) = DataV(2, j) + Cells(i, 12) DataV(3, j) = DataV(3, j) + 1 GoTo 20 End If Next js = js + 1 ReDim Preserve DataV(3, js) DataV(0, js) = Cells(i, 8) DataV(1, js) = Cells(i, 9) DataV(2, js) = Cells(i, 12) DataV(3, js) = 1 20: i = i + 1 Loop '数组排序 Dim m1 As String, m2 As String For i = 1 To js For j = 1 To js - 1 m1 = DataV(0, j) + "|" + DataV(1, j) m2 = DataV(0, j + 1) + "|" + DataV(1, j + 1) If m1 > m2 Then str(0) = DataV(0, j): DataV(0, j) = DataV(0, j + 1): DataV(0, j + 1) = str(0) str(1) = DataV(1, j): DataV(1, j) = DataV(1, j + 1): DataV(1, j + 1) = str(1) str(2) = DataV(2, j): DataV(2, j) = DataV(2, j + 1): DataV(2, j + 1) = str(2) str(3) = DataV(3, j): DataV(3, j) = DataV(3, j + 1): DataV(3, j + 1) = str(3) End If Next Next Range(Cells(1, 14), Cells(js + 1, 17)).Value = Application.Transpose(DataV) Cells(js + 2, 16) = WorksheetFunction.Sum(Range(Cells(2, 16), Cells(i + 1, 16))) Cells(i + 2, 17) = WorksheetFunction.Sum(Range(Cells(2, 17), Cells(i + 1, 17))) Debug.Print "耗费时间: " & Format(Timer - sngStart, "0.0000000000") Cells(1, 14) = "管径" Cells(1, 15) = "材质" Cells(1, 16) = "长度 m" Cells(1, 17) = "数量" Cells(i + 2, 15) = "合计：" End Sub |
【本文地址】
今日新闻 |
推荐新闻 |