'第一种方法更好更通用些,第三种方法最快但不通用,,,
Option Explicit
Sub test1()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheets("表一").[a1].CurrentRegion
For i = 1 To UBound(arr, 1)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
arr = Sheets("表二").[a1].CurrentRegion
For i = 1 To UBound(arr, 1)
arr(i, 1) = IIf(dic.exists(arr(i, 1)), dic(arr(i, 1)), 0)
Next
Sheets("表二").[b1].Resize(UBound(arr, 1)) = arr
End Sub
Sub test2()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheets("表二").[a1].CurrentRegion
For i = 1 To UBound(arr, 1)
dic(arr(i, 1)) = 0
Next
arr = Sheets("表一").[a1].CurrentRegion
For i = 1 To UBound(arr, 1)
If dic.exists(arr(i, 1)) Then dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
Sheets("表二").[c1].Resize(dic.Count) = Application.Transpose(dic.items)
End Sub
Sub test3() '数据比较特殊也可以不用字典
Dim arr, i
arr = Sheets("表一").[a1].CurrentRegion
ReDim brr(999, 1 To 1) As Long
For i = 1 To UBound(arr, 1)
brr(Val(arr(i, 1)), 1) = brr(Val(arr(i, 1)), 1) + 1
Next
Sheets("表二").[d1].Resize(Sheets("表二").[a1].End(xlDown).Row) = brr
End Sub |