[기초방] VBA 100제 #51 [ 주소 나누기 ]

주소 나누기이다.

 

주소는 도시와 지역구로 되어있는데 주소중 대분류로 도시와 지역구로만 시트이름으로 분류하여 통합시트에서 분류하는 문제이다.

 

여기서 함정은 주소의 띄어쓰기가 한칸이상인 주소가 여러 있다는 것이다.

결국 이문제를 풀기위해선 worksheetFunction.Trim과 VBA Trim의 차이를 아냐 모르냐의 문제이다.

transStr = WorksheetFunction.Trim(rngA)   '= 다중 공백을 하나로
vTemp = Split(transStr, " ")              '= 공백으로 Split

juso = vTemp(0) & "_" & vTemp(1)          '= 시트이름을 도시_지역구로

 

또한 이문제는 현재 시트의 이름이 기존에 있는지 없는지를 파악해야 하는데, 이를 위해선 토탈주소라는 것에 새롭게 만들어진 주소를 하나씩 이어 붙혀넣기하면 된다.

total_juso = total_juso & "/" & juso

이 구문만 이해하면 충분히 풀 수 있는 문제이니 하나씩 뜯어보시길 바랍니다.

 

Sub 주소나누기()

    Dim rngAll As Range: Set rngAll = Range([c5], [h5].End(4))   '= 전체영역
    Dim rngA As Range, Header As Range
    Dim juso$, total_juso$
    Dim transStr$
    Dim vTemp
    Dim rngX As Range
    
    
    For Each rngA In rngAll.Columns(4).Cells                    '= 주소 영역 순환
    
        transStr = WorksheetFunction.Trim(rngA)                 '= 다중 공백을 하나로
        vTemp = Split(transStr, " ")                            '= 공백으로 Split
        
        juso = vTemp(0) & "_" & vTemp(1)                        '= 시트이름을 도시_지역구로
        
        If InStr(total_juso, juso) > 0 Then                     '= 시트이름이 있다면 / 기존 시트라면
        
            Set rngX = Intersect(rngAll, rngA.EntireRow)        '= 해당영역을
           
            rngX.Copy Sheets(juso).Cells(Rows.Count, "c").End(3)(2)  '= 기존데이터 아래에 붙혀놓고
            Sheets(juso).Cells(Rows.Count, "f").End(3)(1) = transStr '= 새롭게 변경한 내용을 해당 주소에 넣어라
        
        Else                                                    '= 시트이름이 없다면 / 새로운 시트라면
        
            Set rngX = Intersect(rngAll, rngA.EntireRow)
            
            Set Header = Range([c4], [c4].End(2))               '= 헤더
            Header.Copy         
            
            Sheets.Add after:=Sheets(Sheets.Count)                   '= 시트를 추가하고
            ActiveSheet.Name = juso                                  '= 시트이름을 변경
            [c4].PasteSpecial xlPasteColumnWidths                    '= 복사영역을 복사
            Header.Copy [c4]                                         '= 헤더출력
            rngX.Copy Sheets(juso).Cells(Rows.Count, "c").End(3)(2)  '= 복사된 영역을 출력해라
            Sheets(juso).Cells(Rows.Count, "f").End(3)(1) = transStr '= 새롭게 변경한 내용을 해당 주소에 넣어라
            ActiveWindow.DisplayGridlines = False                    '= 눈금선 해제
        
        End If
        
        total_juso = total_juso & "/" & juso                         '= 주소를 하나씩 추가해서 토탈주소를 만들어라
        Sheets("통합").Activate
    
    Next rngA


End Sub

기초방 51.xlsm

0.02MB