这是在知乎上看到的一个问题，我试着用VBA来解决。欢迎大家就自已使用Excel中遇到的问题或想要的解决方案提问，我将尽力解答。

问题：怎么用EXCEL多条件统计重复次数计数？如下所示，要统计每个试室都有什么专业（F），每个专业多少人，用左边的表生成右边的表（生成M、N、列就行），数据大概4W多条，需要考虑效率。怎么能做出来？VBA，公式啥的行，不想用筛选。

由于没有原始表格，我自已仿照做了一个示例数据表，如下所示。

提问者只要求能够生成右边表格的右侧3列，中为列L、列M、列N，这样的话列I、列J、列K中的数据是应该都有了，这样相对来说更容易一些。由于我没有原始表格，所以我将右边表格的全部6列都使用VBA来生成。

分析左侧的数据表，统计每个试室有什么专业、每个专业有多少人，实际上就是求每个试室每个专业的不重复数。因此，我将场次、考场编码、试室、试室编码、报考专业连接起来，单独放置在列G中，将它们作为字典的键值，这样就得到了不重复的数据。在填充字典键的同时，统计重复的数据，作为键的元素值，从而得到了每个试室每个专业的人数。然后，再将字典键进行拆分，输入到右侧的场次、考场编码、试室、试室编码、报考专业对应单元格中，并将对应的元素值输入到报考人数对应的单元格，这样就得到了统计数据。

完整的VBA代码如下：

Sub StatisticsData()

Dim lngLastRow As Long

Dim rng As Range

Dim myDict As Variant

Dim myKey As Variant

Dim str() As String

Dim num As Long

‘获取数据最后一行

lngLastRow = Range(“A” &Rows.Count).End(xlUp).Row

‘将数据区域单元格中的场次考场编码试室试室编码报考专业数据组合

‘将组合后的数据临时存放在G列

‘每个单元格数据之间用空格分开

‘方便后面拆分

For Each rng In Range(“A2:A” & lngLastRow)

With rng

.Offset( , 6) = .Offset( , ) +” ” + _

.Offset( , 1) +” ” + _

.Offset( , 2) +” ” + _

.Offset( , 3) +” ” + _

.Offset( , 5)

End With

Next rng

‘字典

Set myDict =CreateObject(“scripting.dictionary”)

‘遍历列G中的数据并将其放置在字典中

‘字典中键值为不同的数据组合

‘字典中键对应的值为每种数据组合的数量,即专业报考人数

For Each rng In Range(“G2:G”& lngLastRow)

With myDict

If Not .exists(rng.Value) Then

.Item(rng.Value) = 1

Else

.Item(rng.Value) =.Item(rng.Value) + 1

End If

End With

Next rng

‘清除临时存放在列G中的数据

Range(“G2:G” &lngLastRow).Clear

‘获取字典键

myKey = myDict.keys

‘遍历字典键

For num = To UBound(myKey)

‘拆分字典键中的字符

‘分别对应场次考场编码试室试室编码报考专业

str = Split(myKey(num))

‘取出相应的值并放置在相应的单元格

With Range(“I2”)

.Offset(num, ) = str( )

.Offset(num, 1) = str(1)

.Offset(num, 2) = str(2)

.Offset(num, 3) = str(3)

.Offset(num, 4) = str(4)

.Offset(num, 5) =myDict.Item(myKey(num))

End With

Next num

‘获取统计区域的数据最后一行

lngLastRow = Range(“I” &Rows.Count).End(xlUp).Row

With Range(“I1:N” &lngLastRow)

‘对统计区域的数据排序

.Sort _

Key1:=”场次”, Order1:=xlAscending, _

Key2:=”考场编码”, Order2:=xlAscending, _

Key3:=”试室编码”, Order3:=xlAscending, _

Header:=xlYes

‘调整列宽

.Columns.AutoFit

End With

Set myDict = Nothing

End Sub

代码中有相应的注释，可以参照理解。

阅读全文