這是在知乎上看到的一個問題，我試著用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
代碼中有相應的注釋，可以參照理解。
