글목록

2021년 4월 15일

Module 3. 여러 파일을 하나의 워크시트에 담기-(4)여러 시트 데이터 합치기

동일한 구조를 갖는 여러 개의 파일을 일단 각 워크시트에 열었고, 특정한 위치의 데이터만 한 개의 워크시트로 옮겨담아두면, 그래프를 그린다거나 데이터 분석을 할 때 작업이 쉬워집니다.

예를 들어, 파일 첫 몇줄에 불필요한 주석이 있다거나, 여러 열의 데이터 중 특정 열이나 행의 데이터만 필요하다거나, 특정 영역의 데이터만 추출해서 모으고 싶을 수 있습니다. 그외에도 어떠한 이유에서든 여러개의 파일에서 원하는 부분의 데이터만 추출해야하는 일은 많이 있습니다.

데이터 구조가 동일하다는 가정했을 때, 복수 개의 영역을 선택해서 일괄적으로 복사하는 방법으로 한 개의 워크시트에 데이터를 복사하도록 하겠습니다.


우선, 사용자가 데이터를 추출할 워크시트를 선택합니다. 하단의 워크시트 탭을 Ctrl이나 Shift 버튼을 누르고 마우스로 클릭하면 원하는 갯수의 시트를 선택할 수 있습니다.

선택된 시트에서 원하는 영역을 선택한 후, 선택된 영역의 데이터를 새로운 워크시트에 모두 복사하도록 합니다. 각각의 시트에서 여러 개의 영역을 선택할 수 있도록 하면 좀더 편리할 수 있습니다.

아래에 작성된 매크로를 보면서 설명드리도록 하겠습니다.

---------------------------------------------------------

Sub JoinMultiSheetData()
  On Error GoTo ErrorHandler
  Dim tSel As Sheets, tSh As Worksheet
  Dim tSelCol() As String, tRange As Range, i As Long, j As Long, n As Long, tCollect As Boolean, tCombineCol As Boolean

  '사용자가 여러개의 시트를 선택했다면, 선택된 시트 목록을 가져옵니다.
  Set tSel = ActiveWindow.SelectedSheets

  '복사할 영역을 입력받을 수 있도록 아래와 같이 엑셀의 inputbox를 호출합니다. Ctrl이나 Shift를 조합하여 여러 개의 영역을 선택할 수 있습니다.
  Set tRange = Application.InputBox("복사할 데이터 영역을 선택하세요.", "영역 선택", Type:=8)

  '만약 여러개의 영역을 선택했다면, 각 선택 영역(Area)의 주소를 문자열로 변환합니다. 만약, Area를 그대로 가져가게 되면, 다른 시트의 동일한 영역에 대해서 작업이 어려워지거나 오류가 발생할 수 있기 때문에 선택 영역의 Cell 또는 Range의 주소만 저장해둡니다.
  ReDim tSelCol(1 To tRange.Areas.Count)
  For i = 1 To tRange.Areas.Count
    tSelCol(i) = tRange.Areas(i).Address
  Next
  
  '저는 주로 특정열 데이터를 많이 쓰기 때문에 열 데이터를 가로방향으로 붙여서 배열합니다. 그러나, 어떤 경우에는 행 데이터를 추출해야할 수도 있습니다. 또한 추출한 데이터를 1개 시트에 모아야하는 경우도 있지만, 추출한 데이터를 각각의 시트에 남겨두어야할 수도 있습니다. 따라서, 데이터를 병합할 것인지, 병합하지 않을 것인지, 그리고 데이터를 가로방향으로 붙일지, 세로방향으로 붙일지 선택하도록 해줍니다.
  '열데이터를 가로방향으로 붙이는 것을 디폴트로 해두지만, 만약 가로방향의 데이터가 세로방향의 데이터 수보다 많다면 세로방향으로 데이터를 모을 수도 있으니, 이 경우에는 병합하는 방법을 선택하도록 합니다.
  tCombineCol = True
  If tSel.Count > 1 Then
    tCollect = (MsgBox("1개의 sheet에 합치시겠습니까?" & vbCrLf & " -Yes : 1개 sheet에 선택영역을 모두 합치기" & vbCrLf & " -No : 각각의 sheet에 선택영역만 추출", vbYesNo, "추출 선택") = vbYes)
    If tRange.Rows.Count < tRange.Columns.Count Then tCombineCol = (MsgBox("세로 방향으로 합치시겠습니까?" & vbCrLf & "Yes : 세로방향(▼)/다음 데이터를 하단에 병합, No : 가로방향(▶)/다음 데이터를 우측에 병합", vbYesNo, "병합 설정") = vbNo)
  Else
    tCollect = False
  End If

  '만약 1개의 시트에 데이터를 합치는 것으로 선택했다면, 1개의 시트를 새로 만들고, 시트명을 지정해줍니다.
  Select Case tCollect

    Case True
      Set tSh = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count), Count:=1)
      tSh.Name = NewSheetName("Combined", tSh.Index)
      tSh.Tab.ColorIndex = 36
      n = 1
  '선택된 시트에서 선택된 영역(Area)을 복사해서 새 시트에 붙여넣습니다. 이때, 1번행에 원본 시트명, 2번 행에는 영역 번호를 기입해서 원본의 위치를 함께 기록합니다. 불필요하면 나중에 한꺼번에 삭제할 수 있습니다.
  'HasIntersect는 두 영역이 교차하는 영역이 있는지 확인하는 함수를 작성하였습니다. 원본 시트에서 선택영역이 사용된 영역을 벗어나있다면 데이터가 없다는 것을 의미하므로 두 영역의 교차된 영역이 없다면 복사할 필요가 없기 때문에 체크해줍니다.
  '복사 후 붙여넣을 때에는 값만 복사하도록 하였습니다. 굳이 서식을 다 복사하겠다고 한다면, 옵션을 변경해주면 됩니다.
      For i = 1 To tSel.Count
        If tCombineCol Then
          For j = 1 To UBound(tSelCol)
            tSh.Range(Cells(1, n), Cells(1, n + tSel(i).Range(tSelCol(j)).Columns.Count - 1)).Value = tSel(i).Name
            tSh.Range(Cells(2, n), Cells(2, n + tSel(i).Range(tSelCol(j)).Columns.Count - 1)).Value = "Area " & j
            If HasIntersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j))) Then
              Set tRange = Application.Intersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j)))
              tRange.Copy
              tSh.Cells(3, n).PasteSpecial xlPasteValues
            End If
            n = n + tSel(i).Range(tSelCol(j)).Columns.Count
          Next
        Else
          For j = 1 To UBound(tSelCol)
            tSh.Range(Cells(n, 1), Cells(n + tSel(i).Range(tSelCol(j)).Columns.Count - 1, 1)).Value = tSel(i).Name
            tSh.Range(Cells(n, 2), Cells(n + tSel(i).Range(tSelCol(j)).Columns.Count - 1, 2)).Value = "Area " & j
            If HasIntersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j))) Then
              Set tRange = Application.Intersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j)))
              tRange.Copy
              tSh.Cells(n, 3).PasteSpecial xlPasteValues
            End If
            n = n + tSel(i).Range(tSelCol(j)).Rows.Count
          Next
        End If
      Next
      tSh.Select
      tSh.Activate
      tSh.Cells(1, 1).Select

  '만약, 선택된 데이터를 1개의 시트에 합치지 않고, 각각의 시트에 추출하겠다고 선택했다면, 선택된 시트 갯수만큼 새로운 시트를 만들고, 선택영역을 복사해서 붙여넣어줍니다.
    Case False

      For i = 1 To tSel.Count
        Set tSh = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count), Count:=1)
        tSh.Name = NewSheetName(tSel(i).Name & "-Ex", tSh.Index)
        tSh.Tab.ColorIndex = 50
        n = 1
        For j = 1 To UBound(tSelCol)
          If HasIntersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j))) Then
            Set tRange = Application.Intersect(tSel(i).UsedRange, tSel(i).Range(tSelCol(j)))
            tRange.Copy
            tSh.Cells(1, n).PasteSpecial xlPasteValues
          End If
          n = n + tSel(i).Range(tSelCol(j)).Columns.Count
        Next
        tSh.Select
        tSh.Activate
        tSh.Cells(1, 1).Select
      Next
  End Select
ErrorHandler:
  Erase tSelCol
End Sub

Function HasIntersect(iRange1 As Range, iRange2 As Range) As Boolean
  '두개의 영역을 입력했을 때, 두 영역의 교차 영역이 있는지 확인하는 함수입니다. 만약, 둘 중 1개라도 Nothing이면 교차영역이 없으므로 False를 반환하고, 그렇지 않은 경우, 교차 영역이 있는지 체크해서 결과값을 반환해줍니다.
  'Application.Intersect는 두 영역이 모두 Nothing이 아닐 때에만 교차영역을 반환해주고, 아니면 에러가 발생합니다.
  If (iRange1 Is Nothing) Or (iRange2 Is Nothing) Then
    HasIntersect = False
  Else
    HasIntersect = Not (Application.Intersect(iRange1, iRange2) Is Nothing)
  End If
End Function

---------------------------------------------------------

위의 함수에서, 입력하는 매개변수에 Nothing이 입력될 일은 거의 없겠지만, 간혹 Nothing이 입력되는 경우가 있습니다. 예를 들어, Range 변수가 선언은 되었으나, 아직 정의되지 않은 상태라거나, 필요에 의해 변수를 초기화시켜버리는 경우도 있기 때문에 이러한 상황에서 교차 영역을 찾으라고 하면 오류가 날 수 있습니다.

그런 상황이 많지는 않겠지만, 이렇게 교차영역이 있는지 체크하는 함수를 정의해두면 의외로 쓰이는 일이 많이 있습니다.


여기까지, 여러 파일을 한꺼번에 엑셀에 열어서, 원하는 영역을 일괄적으로 합치는 매크로를 작성하였습니다.


댓글 없음:

댓글 쓰기

의견이나 질문이 있으신 분은 언제든지 댓글을 달아주세요~

많이 본 글 :