[기초방] VBA 100제 #26 [ 그룹별 시트 만들기 ]

정렬되지 않은 이름들을 순환하면서 각 그룹을 만드는 구문이다.

 

하나의 시트로만 작업을 해왔던 분들이면 다중 시트를 생성하면서 작업하는 것이 낯설 수도 있다. 실무에서도 많이 사용되는 구문이기에 하나씩 잘 정리하길 바란다.

Sheets.Add after:=Sheets(Sheets.Count)          
ActiveSheet.Name = rngX

참 고급스킬이다. 시트를 추가하는 데 그 위치는 현재 생성된 시트들의 맨 뒤에 시트를 추가하고, 그 이름을 특정 변수 값으로 하는 내용이다. 반드시 숙지하길 바란다.

Cells(Rows.Count, "b").End(3)(2).Resize(1, 2) = Array(rngA, rngA.Next)

여기서 Array를 주목해보자.

Array 안 썼다면 아래와 같이 각각을 분리하여 작성하여야 한다.

Cells(Rows.Count, "b").End(3)(2) = rngA
Cells(Rows.Count, "c").End(3)(2) = rngA.Next

실무에 적용하여 월급루팡이 되어보자....

Option Explicit

Sub 기초방26()

    Dim rngAll As Range: Set rngAll = Sheets("통합").[a5].CurrentRegion
    Dim rngA As Range
    Dim sh As Worksheet
    Dim rngX As Range: Set rngX = Sheets("통합").[f6]
 
    rngAll.Copy [f5]                                        '= 기초방 26번문제

    [f5].CurrentRegion.RemoveDuplicates 1, 1
    
    [g6:g11] = "=SUMIFS($B$6:$B$496,$A$6:$A$496,F6)"        '= 기초방 26번문제
    
    Do Until IsEmpty(rngX)                                  '= 추출된 이름들은 순환해라
    
        Sheets.Add after:=Sheets(Sheets.Count)              '= 시트를 추가는 현재 시트수의 다음번째에 추가해라
        ActiveSheet.Name = rngX                             '= 시트 이름은 추출된 이름으로 해라
        
        Sheets("통합").[a5:b5].Copy ActiveSheet.[b5]        '= 시트안에 이름/매출 헤드를 복사 붙혀넣기 해라
        For Each rngA In rngAll.Columns(1).Cells           '= 통합 시트에 있는 이름들은 순환해라
            
            If rngA = rngX Then                             '= 추출된 이름과 통합시트의 이름과 일치하면
                
               Cells(Rows.Count, "b").End(3)(2).Resize(1, 2) = Array(rngA, rngA.Next) '= 생성된 시트에 누적으로 추출해라
               
            End If
        
        Next rngA
            
        Haja_Format
        Set rngX = rngX.Offset(1)
    
    Loop
    Sheets("통합").Activate                                 '= 통합시트로 이동
    MsgBox "추출완료"

End Sub

Function Haja_Format()

    Columns("c").NumberFormat = "#,##0"
    With [b5].CurrentRegion
        .Borders.LineStyle = 1
        .HorizontalAlignment = xlCenter
    End With
        

End Function

기초방26.xlsm

0.05MB