- Sub ts()
- Dim arr, brr
- Dim i As Long, m As Long
- Dim dic As Object
- Set dic = CreateObject("scripting.dictionary")
- arr = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
- For i = 1 To UBound(arr)
- If Not dic.exists(arr(i, 1)) Then
- dic.Add arr(i, 1), ""
- Else
- dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) + 1
- End If
- Next i
- [c1].Resize(dic.Count) = Application.Transpose(dic.keys)
- [d1].Resize(dic.Count) = Application.Transpose(dic.items)
- Set dic = Nothing
- End Sub
½Æ»s¥N½X °õ¦æ®É¡Adic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) + 1
¥X²{¿ù»~13¡A«¬ºA¤£²Å¦X°ÝÃD
¥i¥H½Ð±Ð¸ô¹L¬Ý¨ìªº¤j¤j¡A½Ð°Ý°ÝÃD¬O¦b¨º¸Ì©O |