[VBA]특정문자를 포함한 시트만 선택하여 저장

'지식인에서 엑셀 관련 질문에 답변을 해주다가 VBA공부를 시작했다. 다음은 어느 분이 '연도-월'의 이름을 가진 시트가 많이 있는 파일에서, 연도별로 시트를 저장하고, 올해 1월과 작년 12월, 그리고 연도가 아닌 글자로 시트명이 된 시트들을 따로 모아 저장해달라는 의뢰(?)에 대한 연구 결과이다

파일로 다운 받기

Option Explicit                         '변수를 선언해야 사용할 수 있다는 옵션
Sub MergeWBs()                   '매크로 이름
Dim i As Integer                '순환문 작업에 필요한 변수
Dim shtnum As Integer           '시트의 총갯수를 저장하기위한 변수
Dim sh As Worksheet              '선택한 시트를 복사할 때 시트 각각에 배당하는 변수
Dim shs As Sheets                 '선택한 시트 전체에 배당하는 변수
Dim wkbtg As Workbook              '새로 만드는 엑셀파일에 배당하는 병수
Dim MyPath As String                       '저장위치
Dim strThisYr As String                        '올해 연도를 담을 변수
Dim strOldYr As String                           '이전 연도를 담을 변수
Dim strshname As String                     '시트명을 담을 변수

Application.DisplayAlerts = False          '실행속도를 빠르게하기 위해 경고,이벤트 등을 꺼둔다
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "d:\"                                             '저장하는 폴더 위치를 등록해둔다. 저장할 위치를 옮기고 싶으면 여기만 고치면 된다

strThisYr = DatePart("yyyy", Now)     '올해의 연도를 strThisYr 이라는 변수에 등록
strOldYr = strThisYr                          '올해의 작업을 맨 먼저 실시할 예정이므로 이전연도를 담을 변수에 일단은 올해 연도를 담는다.

strshname = strThisYr & "-01"             '올해 1월의 시트명 2017-01을 시트명 변수에 등록

On Error GoTo nothisyear                 '만약 올해 1월 시트가 없거나 해서 에러가 나면 다음으로 넘어가서 이전연도 시트 정리작업만이라도 수행하도록 한다
Workbooks(1).Sheets(strshname).Select       '올해 1월 시트 선택
On Error GoTo nothisyear                '만약 작년12월 시트가 없거나 해서 에러가 나면 다음으로 넘어가서 이전연도 시트 정리작업만이라도 수행하도록 한다

strshname = strThisYr - 1 & "-12"        '작년 12월의 시트명 2016-12을 시트명 변수에 등록

Workbooks(1).Sheets(strshname).Select (False)   '아까 선택한 시트에 추가하여 작년 12월 시트 선택한다. 여기서 false는 추가 선택, true는 이전선택버리고 새 선택

nothisyear:                                 '에러가 났을 때 넘어올 곳

shtnum = ThisWorkbook.Sheets.Count        '시트 전체의 개수를 shtnum 변수에 등록

For i = shtnum To 1 Step -1                        '모든 시트마다 작업을 수행한다. 큰수에서부터 내려오는 이유는, 작업 후반부에 시트를 삭제할 예정이라, 작은수에서부터 올라가면 빠뜨리는 시트가 생길 수 있기 때문이다
        If Not IsNumeric(Left(Workbooks(1).Sheets(i).Name, 4)) Then
                                       '시트명의 왼쪽4 글자가 숫자(즉, 연도)가 아니라면
        Workbooks(1).Sheets(i).Select (False)
                               '앞에서 선택한 시트에 추가하여 현재 시트를 선택한다
        End If
Next i        '이 작업을 시트마지막까지 수행한다
 ' 이제 2016-12, 2017-01, 시트명이 글자로 된 시트를 모두 선택했다

Set shs = Windows(1).SelectedSheets     '선택한 시트들을 shs라는 변수에 넣는다.
Set wkbtg = Workbooks.Add()            '새로운 엑셀파일에 변수 wkbtg를 할당한다. 재미있는 것은 뒤에 add메서드가 붙어있어서, 정의하는 순간 엑셀파일이 새로 만들어진다

For Each sh In shs                'shs (선택한 시트들)에 있는 sh모든 시트들에 대해 작업을 수행
sh.Copy wkbtg.Sheets(1)        '시트 하나를 '새로만들어진 엑셀파일에 복사한다. 
Next sh
shs.Delete   '복사가 끝났으면 원본 파일에서 선택된 시트들은 삭제

wkbtg.SaveAs Filename:=MyPath & strThisYr & "년.xlsx"           '시트가 복사된 새로운 엑셀파일을 저장한다. 처음에는 올해의 연도로 저장한다.
wkbtg.Close       '저장되었으면 닫는다.

shtnum = ThisWorkbook.Sheets.Count     '이제 시트가 몇개 삭제되었으니 시트의 총 갯수가 저장된 변수를 다시 갱신한다.

'이제 이전연도 시트를 정리하는 순서이다. 올해연도는 시트명이 글자인 것까지 모아서 저장하므로, 시트명이 숫자로 된 것들만 저장하는 것과는 다른 과정을 거쳐야한다.

'처음에는 2017년시트를 정리하고, 그 다음 2016년, 2015년 식으로 차례로 내려오려고 했는데, 문제가 있었다. 즉, 위의 작업에서 시트를 없애고 나면 자동으로 그다음 시트를 엑셀에서는 선택하는데, 그 선택된 시트를 선택해제(Unselect)하는 방법이 없었다
'그래서 결국 임의로 선택된 시트의 연도와 같은 연도의 시트부터 정리를 하는 방식을 택했다.

Do               '반복작업 선언

strOldYr = Left(Workbooks(1).ActiveSheet.Name, 4)  '이전 연도 변수 strOldYr에 현재 선택된 시트의 왼쪽 네자리 (연도)를 배정한다.

For i = shtnum To 1 Step -1              '마찬가지로 후반부에 시트를 삭제할 예정이므로 큰숫자(맨끝시트)에서 내려온다
If Left(Workbooks(1).Sheets(i).Name, 4) = strOldYr Then  '맨 끝 시트의 왼쪽 네자리가 현재 선택된 시트의 네자리와 같으면
Workbooks(1).Sheets(i).Select (False)   '앞에 선택된 시트에 추가하여 시트 선택
End If
Next i      ' 반복 실행

'앞에서와 같은 작업으로, 선택된 시트를 새로운 엑셀파일로 복사한다. 이 부분만 따로 매크로를 만들어 Call하는 방식으로 만들수도 있을 것이다
Set shs = Windows(1).SelectedSheets
Set wkbtg = Workbooks.Add()

For Each sh In shs
sh.Copy wkbtg.Sheets(1)
Next sh


Workbooks(2).SaveAs Filename:=MyPath & strOldYr & "년.xlsx"   ' 이전연도를 파일명으로하여 저장한다.
Workbooks(2).Close                                ' 파일 닫기

'선택된 시트를 삭제할 차례인데, 이게 맨 마지막 차례라면 오류가 생긴다. 즉, 엑셀파일에는 최소한 한 개의 시트는 있어야하므로, 마지막에 모든 시트가 삭제되면 오류가 생기는 것이다
'그래서 선택된 시트를 모두 삭제하면 시트가 하나도 남지 않을 것 같을 때, blank라는 이름의 시트를 하나 삽입하고, blank시트 외에 다른 시트는 삭제한다.

If shs.Count < shtnum Then          '선택된 시트의 갯수가 전체 시트의 갯수보다 적으면
shs.Delete                                        '선택된 시트를 삭제
Else: ActiveWorkbook.Sheets.Add.Name = "blank"         '그렇지 않다면 “blank”라는 이름의 시트를 삽입한다

            For Each sh In Worksheets        '그리고 모든 시트에 대해
                If sh.Name <> "blank" Then       '시트이름이 blank가 아니면 삭제한다
                    sh.Delete
                End If
            Next
End If

shtnum = ThisWorkbook.Sheets.Count   '이제 시트가 몇개 삭제되었으므로 전체시트의 갯수를 나타내는 변수를 다시 할당한다

Loop While shtnum > 1     '위의 작업을 계속 반복하는데 시트의 갯수가 1개보다 많은 동안에는 계속한다. 즉, 시트의 갯수가 1개가 되면 중지한다. 그 1개의 시트는 바로 위에서 추가한 blank 시트이다

ActiveWorkbook.Close False      '모든 작업이 끝났으므로 열려있는 원본시트를 닫는다.

Application.DisplayAlerts = True     '실행속도를 빠르게 하기 위해 꺼두었던 경고,이벤트등의 설정을 다시 켠다
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub  
연구할 거리:
1.       sh.Copy wkbtg.Sheets(1)        신기한 것은, 원래는 여기를 windows(1).selectedsheets.copy 로 했었는데 명령이 먹지 않는 것이었다. 그런데 windows(1).selectedsheets. 부분을 변수로 바꾸고하니 작동이 잘 된다. 이유를 연구할 필요가 있다
2. 'worksheet는 엑셀계산을 하는 시트, sheet는 차트를 포함한 더 넓은 범위라고 한다. 변수 shs를 worksheet로 정의하면 어떻게 되는지 확인 필요
3. On Error GoTo nothisyear                 '만약 올해 1월 시트가 없거나 해서 에러가 나면 다음으로 넘어가서 이전연도 시트 정리작업만이라도 수행하도록 goto를 사용했는데, 오류가 없는지 

p.s 처음에 지식인에 답변을 달았으나, 질문자가 원하는 답변이 아니었고, 질문자가 원하는 작업을  설명한 내용 중 무심코 읽고 넘어갔던 부분에 의심스러운 점을 발견했다.  만약 그렇다면 지금의 코드와는 많이 달라져야한다고 하자, 맞다면서, '원래 그런건 알아서 해 줄줄 알았다'는 태도를 보여서 살짝 화가 났다. 
공부를 겸한 것이기에 결국 해답은 찾아냈지만, 과연 지식인에 답변을 해 줄지는 모르겠다. 지식인은 무료로 (내공을 받는다지만 그건 돈 한푼 값어치도 없다) 일종의 재능기부를 하는 곳인데, 납품업체에게 하듯이 대하는 태도를 보니 답변할 마음이 싹 가신다. 

댓글

이 블로그의 인기 게시물

중복된 텍스트 제외하고 고유 텍스트 개수 세기

1일1함수 (12) sumproduct함수 - 동점일때 다른 기준으로 순위매기기

1일1함수 (31) SUMIF함수 : 조건에 맞는 셀의 값을 더하기, 절대참조와 상대참조