|
▼質問者 さん:
ディクショナリで処理して見ました。
数秒で終わると思います。
未検証です。
Sub TESTaa()
Dim i As Long
Dim v1 As Variant
Dim v2 As Variant
Dim v3 As Variant
Dim Dic As Object
v1 = Range("Q2:Q274872").Value
v2 = Range("A2:A274872").Value
ReDim v3(1 To UBound(v2), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
' 最初に同じ物は合計して置く
For i = 1 To UBound(v1)
If Dic.Exists(v1(i, 1)) Then
Dic(v1(i, 1)) = Dic(v1(i, 1)) + 1
Else
Dic(v1(i, 1)) = 1
End If
Next
' 全件チェックあったら数量をセット
For i = 1 To UBound(v2)
If Dic.Exists(v2(i, 1)) Then
v3(i, 1) = Dic(v2(i, 1))
End If
Next
Range("S2").Resize(UBound(v3)).Value = v3
End Sub
|
|