동일한 구조를 갖는 여러 개의 파일을 일단 각 워크시트에 열었고, 특정한 위치의 데이터만 한 개의 워크시트로 옮겨담아두면, 그래프를 그린다거나 데이터 분석을 할 때 작업이 쉬워집니다.
예를 들어, 파일 첫 몇줄에 불필요한 주석이 있다거나, 여러 열의 데이터 중 특정 열이나 행의 데이터만 필요하다거나, 특정 영역의 데이터만 추출해서 모으고 싶을 수 있습니다. 그외에도 어떠한 이유에서든 여러개의 파일에서 원하는 부분의 데이터만 추출해야하는 일은 많이 있습니다.
데이터 구조가 동일하다는 가정했을 때, 복수 개의 영역을 선택해서 일괄적으로 복사하는 방법으로 한 개의 워크시트에 데이터를 복사하도록 하겠습니다.
우선, 사용자가 데이터를 추출할 워크시트를 선택합니다. 하단의 워크시트 탭을 Ctrl이나 Shift 버튼을 누르고 마우스로 클릭하면 원하는 갯수의 시트를 선택할 수 있습니다.
선택된 시트에서 원하는 영역을 선택한 후, 선택된 영역의 데이터를 새로운 워크시트에 모두 복사하도록 합니다. 각각의 시트에서 여러 개의 영역을 선택할 수 있도록 하면 좀더 편리할 수 있습니다.
아래에 작성된 매크로를 보면서 설명드리도록 하겠습니다.
---------------------------------------------------------
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 tRange = Application.InputBox("복사할 데이터 영역을 선택하세요.", "영역 선택", Type:=8)
ReDim tSelCol(1 To tRange.Areas.Count)
For i = 1 To tRange.Areas.Count
tSelCol(i) = tRange.Areas(i).Address
Next
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
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
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.Activate
tSh.Cells(1, 1).Select
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
Else
HasIntersect = Not (Application.Intersect(iRange1, iRange2) Is Nothing)
End If
End Function
---------------------------------------------------------
위의 함수에서, 입력하는 매개변수에 Nothing이 입력될 일은 거의 없겠지만, 간혹 Nothing이 입력되는 경우가 있습니다. 예를 들어, Range 변수가 선언은 되었으나, 아직 정의되지 않은 상태라거나, 필요에 의해 변수를 초기화시켜버리는 경우도 있기 때문에 이러한 상황에서 교차 영역을 찾으라고 하면 오류가 날 수 있습니다.
그런 상황이 많지는 않겠지만, 이렇게 교차영역이 있는지 체크하는 함수를 정의해두면 의외로 쓰이는 일이 많이 있습니다.
여기까지, 여러 파일을 한꺼번에 엑셀에 열어서, 원하는 영역을 일괄적으로 합치는 매크로를 작성하였습니다.
댓글 없음:
댓글 쓰기
의견이나 질문이 있으신 분은 언제든지 댓글을 달아주세요~