Dictionary

카테고리별로 시트 생성하여 나누기

VBA는 취미로 2024. 2. 19. 17:26
Sub CreateSheetsBasedOnCategory()

    Dim categoryCol As Variant
    Dim category As Variant
    Dim rowIndex As Long
    Dim categoryDict As Object

    Set categoryDict = CreateObject("Scripting.Dictionary")

    With Sheets("Product").Range("A1").CurrentRegion

        categoryCol = .Columns(2).Value

        For rowIndex = 2 To UBound(categoryCol, 1)

            If Not categoryDict.exists(categoryCol(rowIndex, 1)) Then
                Set categoryDict(categoryCol(rowIndex, 1)) = .Rows(rowIndex)
            Else
                Set categoryDict(categoryCol(rowIndex, 1)) = Union(categoryDict(categoryCol(rowIndex, 1)), .Rows(rowIndex))
            End If

        Next

    End With

    For Each category In categoryDict

        If Not Evaluate("ISREF('" & category & "'!A1)") Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = category
        Else
        End If

        Sheets(category).Cells.Clear
        Sheets("Product").Range("A1:E1").Copy Destination:=Sheets(category).Range("A1:E1")
        categoryDict(category).Copy Sheets(category).Range("A2")

    Next

End Sub

 

매크로 실행 전

 

매크로 실행 후