Excel VBA 多条件筛选及汇总统计 1、人工操作方法2、VBA编程的方法

60 阅读 0 评论 40 点赞

我是靠谱客的博主无限纸鹤，最近开发中收集的这篇文章主要介绍Excel VBA 多条件筛选及汇总统计 1、人工操作方法2、VBA编程的方法，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

Excel VBA 多条件筛选 AdvancedFilter 汇总统计 sumproduct Range与Array交换

在日常工作中，面对Excel表格数据，为了分类进行统计，通过对表格数据筛选获取分类条目，再按条目实行汇总统计。要完成上面的工作，有人工操作和开发程序两种方法，本文通过一个有10000行数据的管线调查表，对不同管径、管材进行分类统计数量和长度，详细介绍人工操作和VBA程序开发这两种方法。

1、人工操作方法

1.1高级筛选

Excel菜单：数据-高级找开高级筛选对话框，如下图：

对话框中：方式：将筛选结果复制到其他位置

列表区域：选择需要筛选的区域

复制到：筛选结果粘贴位置（没有数据的空白区域）

选择不重复的记录：打钩

确定后得到的结果如下图

1.2分类统计

在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