上一篇发布的数字统计，采用的是常规方法，运行速度比较慢，这一篇采用了数组的方法进行统计。运行速度会快很多。但是这篇文章把表格进行了简化。
数据如图：
数组的代码如下:
Sub test()
Dim arr, brr, crr
Dim rng, i, k
Dim j As Integer
'获取最后一个动态行
rng = Range("a" & Rows.Count).End(xlUp).Row
'数据源
arr = Range("A3:D" & rng)
'数据区
Range("E3:N10000") = ""
brr = Range("E3:N" & rng)
'运算过程
For k = 1 To UBound(arr, 1)
For i = 1 To UBound(arr, 2)
j = arr(k, i)
brr(k, j) = brr(k, j) + 1
Next i
Next k
'写入数据
Range("E3:N" & rng) = brr
'对所的行进行求和
Range("E" & rng + 3 & ":N" & rng + 3) = ""
crr = Range("E" & rng + 3 & ":N" & rng + 3)
For i = 1 To UBound(brr, 2)
crr(1, i) = Application.WorksheetFunction.Sum(Application.WorksheetFunction.Index(brr, 0, i))
Next
Range("E" & rng + 3 & ":N" & rng + 3) = crr
'对最后5行进行求和
rng = rng - 4
Range("E" & rng + 9 & ":N" & rng + 9) = ""
crr = Range("E" & rng + 9 & ":N" & rng + 9)
brr = Range("E" & rng & ":N" & rng + 4)
For i = 1 To UBound(brr, 2)
crr(1, i) = Application.WorksheetFunction.Sum(Application.WorksheetFunction.Index(brr, 0, i))
Next
Range("E" & rng + 9 & ":N" & rng + 9) = crr
End Sub
代码运行结果如下：
由于有几行代码太长，避免误解。贴上源代码的截图
源代码截图：