|
楼主 |
发表于 2020-7-31 09:32
|
显示全部楼层
Option Explicit
Sub quc()
Dim i%, j%, d As Object, n&, arr, k, t, sh As Worksheet, m
n = ActiveSheet.Cells.Rows.Count
m = ActiveSheet.Cells(n, 1).End(3).Row
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1:a" & m)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1
Next
k = d.keys
t = d.items
Set sh = Worksheets.Add
sh.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)
[a1].Resize(1, 2) = Array("name", "times")
Set d = Nothing
End Sub
|
|