Sub jimin()
Dim i&, Myr&, Arr
Dim brr(1 To 1000, 1 To 3)
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:b" & Myr)
For i = 2 To UBound(Arr)
If Not d.exists(Arr(i, 1)) Then
k = k + 1
d(Arr(i, 1)) = k
brr(k, 1) = Arr(i, 1)
If Arr(i, 2) < 2 Then
brr(k, 2) = 1
Else
brr(k, 3) = 1
End If
Else
If Arr(i, 2) < 2 Then
brr(d(Arr(i, 1)), 2) = brr(d(Arr(i, 1)), 2) + 1
Else
brr(d(Arr(i, 1)), 3) = brr(d(Arr(i, 1)), 3) + 1
End If
End If
Next
Range("i2:k1000").ClearContents
Range("i2").Resize(UBound(brr), 3) = brr
Set d = Nothing
End Sub
|