|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub safd()
Dim arr(), arr2(), arr3()
Dim myDict As Object
Set myDict = CreateObject("Scripting.Dictionary")
col1 = Cells(Rows.Count, 2).End(xlUp).Row - 1
arr = Cells(2, 1).Resize(col1, 1).Value
For i = 1 To UBound(arr)
j = arr(i, 1)
If myDict.Exists(j) Then
myDict(j) = myDict(j) + 1
Else
myDict(j) = 1
End If
Next i
arr2 = myDict.Keys
arr3 = myDict.Items
Range("d1").Resize(myDict.Count, 1) = WorksheetFunction.Transpose(arr2)
Range("e1").Resize(myDict.Count, 1) = WorksheetFunction.Transpose(arr3)
End Sub
|
|