[VBA] 항목별 갯수 구하기

네이버지식인에 VBA 고수분이 답변해준 내용인데

나중에 활용할 일이 있을 거 같아서 코드를 실행해보고 인터넷을 뒤져서 의미가 뭔지 파악하고 추가 해설까지 적어서 기록해둔다.

For Next 문을 돌리고 RemoveDuplicates 함수를 이용해도 될 거 같은데 Collection 과 Cstr 함수를 이용하고 동적배열 ReDim Preserve 를 사용하고, Transpose 함수 기능을 사용했다.

아직은 내가 잘 사용을 안해본 함수/기능을 많이 사용했다.

Err Number 가 의미하는 것을 알려고 구글링해서 https://support.microsoft.com/en-us/kb/146864 에서 코드 부분만 내블로그에 적어두었다.

항목별갯수_VBA.xlsm

Sub 항목별갯수()
    Dim X As New Collection
    Dim rngAll, rngC, Rev() As Variant
    Dim i As Integer, n As Integer
   
    rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    Range("D2:E" & Rows.Count).ClearContents
    On Error Resume Next   '// 에러가 발생했을 경우 계속해서 다음을 실행하라
    For Each rngC In rngAll
        X.Add rngC, CStr(rngC)

        '//컬렉션 오브젝트의 기본형태는 [오브젝트명.Add Item, key, (before), (after)]
        '//여기서 key 요소는 unique한 텍스트, 즉 중복되지 않는 텍스트일 경우에만 유효하다
        '// 즉, 위에서 나왔던 값을 밑에서 또 만나면 에러가 발생하게 되고, 따라서 아이템에 추가가 되지 않는다

        If Err.Number <> 457 Then   '// 이미 할당된 요소(element) 가 아니면
            Set rngDB = Range([A2], Cells(Rows.Count, "A").End(3))
            ReDim Preserve Rev(1 To 2, n)
            Rev(1, n) = rngC
            Rev(2, n) = WorksheetFunction.CountIf(rngDB, rngC)
            n = n + 1
        End If
        Err.Clear
    Next rngC
    Range("D2").Resize(n, 2) = Application.Transpose(Rev)
End Sub