9월 8 2015
엑셀(EXCEL) – 시트 통합, 월간년간보고서 작성 및 특정자료(대리점) 추출
보통 일간 주문현황이나 생산현황 등 일간 보고서를 양식으로 만들고 각 시트마다 자료를 정리하고
월간이나 분기, 반기, 년간 별로 보고 자료를 작성해야하는 경우 그 자료를 취합하기가 만만찮은
작업입니다. 일간 자료를 시트마다 전체 복사해서 한 시트에 모으는 것도 장난?아닌데 년간 자료를
만드는 것은 상상하기도 힘든 작업입니다. (물론 일간이 모여 월간자료가 생성되면 조금은 덜하지만)
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3523876
(엑셀 – 여러 시트에서 특정 값이 들어있는 행 가져오기)
며칠간 도저히 버그를 잡지 못해 일단 올리고 봅니다. 루프가 돌기는 도는데 계속 클릭을 하는 순서에
따라 순차적으로 검색이 되고 안되기를 하는데 원인을 찾지를 못해서 사용은 할 수 있을 것 같아서
일단 올리고 버그는 더 잘아시는 분이 코드에서 찾아서 댓글로 올려 주세요. …
ps> 버그 잡았습니다. … 역시 벌레는 찾는 곳이 아닌 다른 곳에 숨어 있었군요.
For Each sht In wrk.Worksheets
If sht.Name = “Master” Or sht.Name = “ExtData” Then
sht.Delete
Exit Sub
End If
Next sht
위의 삭제 시트 코드와 저 아래의 시트 삭제 코드에서 Exit Sub를 주석처리하면 됩니다.
루틴을 돌려보니 한 번은 되고 한 번은 안되고 하는 이유가 보이네요. 시트가 없으면 실행되고
시트가 있으면 시트 삭제하고 Sub를 마쳐버려서 그렇네요.
유저폼의 리스트를 클릭하면 하나는 되고 그다음 클릭은 되지 않고 아무거나 눌러서 가짜 클릭을?
만들고 원하는 리스트를 클릭하면 자료가 만들어지는 순환구조상으로는 아무 문제가 없는데?
문제가 나타나는 기이한 버그?입니다. 여러 방법으로 처리를 해 보았는데 똑같은 결과가 나오는
것으로 보아 해당 코드에 버그가 있는데 도저히 보이지를 않습니다. 아래 코드입니다.
Do While Range(“START”).Offset(i, 1) <> “”
If Left(Range(“START”).Offset(i, 2), InStr(Range(“START”).Offset(i, 2), “-“) – 1) = FindStr
Then
Range(Range(“START”).Offset(i, 0), Range(“START”).Offset(i, 17)).Copy
intCount = intCount + 1
trg.Range(“A1”).Offset(intCount, 0).Select
trg.Paste
End If
i = i + 1
Loop
우선 워크시트를 통합하는 코드와 폴더(디렉토리)에 모여있는 모든 엑셀 화일을 통합하는코드입니다.
Option Explicit
Sub MergeWBs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = “C:\Data”
Set wbDst = ThisWorkbook
strFilename = Dir(MyPath & “\*.xls”, vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = “”
Set wbSrc = Workbooks.Open(Filename:=MyPath & “\” & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy after:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub MergeWSs()
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer
Set wrk = ActiveWorkbook
Application.DisplayAlerts = False
For Each sht In wrk.Worksheets
If sht.Name = “Master” Or sht.Name = “ExtData” Then
sht.Delete
Exit Sub
End If
Next sht
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set trg = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = “Master”
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
.Interior.Color = vbGreen
End With
For Each sht In wrk.Worksheets
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value =
rng.Value
Next sht
trg.Activate
Range(“A2″).Select
ActiveWorkbook.Names.Add Name:=”START”, RefersToR1C1:=”=Master!R2C1″
trg.Columns.AutoFit
Call ExtUniqItemRng(UserForm1.ListBox1)
UserForm1.Show
Application.ScreenUpdating = True
End Sub
통합된 자료에서 추출하고자 하는 문자열을 구하는 루틴입니다. 제 팁에서 자주 사용되고 있는 루틴을
변형하여 특정 값에서 문자를 추출하고 그 추출된 문자열의 중복 항목을 제거하여 사용자폼의 리스트에
정렬하는 방법입니다. VBA에서 Userform을 하나 만드시고 Listbox하나를 만들어 Object로 넘기는
소스입니다.
Sub ExtUniqItemRng(obj As Object)
Dim TempStr As String
Dim intNum As Integer
Dim NumCnt As Integer
Dim Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, item
Dim UniqStr As String
Dim TgtCel As Range
Dim SelRng As Range
Set SelRng = Range(“C2”, Range(“C2”).End(xlDown))
Application.ScreenUpdating = False
On Error Resume Next
For Each Cell In SelRng
If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
‘ Add method의 2번째 인자는 문자열이어야만 함
NoDupes.Add Left(Cell.Value, InStr(Cell.Value, “-“) – 1), Left(CStr(Cell.Value), InStr(CStr
(Cell.Value), “-“) – 1)
End If
Next Cell
On Error GoTo 0
For i = 1 To NoDupes.Count – 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
For Each item In NoDupes
obj.AddItem item
Next item
Set Cell = Nothing
Application.ScreenUpdating = True
End Sub
Userform의 Listbox의 Listitem을 클릭할 때마다 List내용을 받아서 자료를 추출하는 소스입니다.
Sub ExtItemSelect(FindStr As String)
Dim i As Integer, cnt As Integer
Dim colCount As Integer, intCount As Integer
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim Ccel As Range
Dim SelRng As Range
Set wrk = ActiveWorkbook
Application.DisplayAlerts = False
For Each sht In wrk.Worksheets
If sht.Name = “ExtData” Then
sht.Delete
Exit Sub
End If
Next sht
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set trg = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = “ExtData”
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
.Interior.Color = vbRed
End With
Do While Range(“START”).Offset(i, 1) <> “”
If Left(Range(“START”).Offset(i, 2), InStr(Range(“START”).Offset(i, 2), “-“) – 1) = FindStr
Then
Range(Range(“START”).Offset(i, 0), Range(“START”).Offset(i, 17)).Copy
intCount = intCount + 1
trg.Range(“A1”).Offset(intCount, 0).Select
trg.Paste
End If
i = i + 1
Loop
Application.ScreenUpdating = True
Columns.AutoFit
End Sub
순환 논리는 맞는데 아무리 봐도 추출되지 않는 원인이 보이지 않으니 답답하지만
누가 잘 해결해 주실거라고 믿고 팁란에 올립니다.
첨부 화일 : 20150908-시트 통합, 월간년간보고서 작성 및 특정 자료 추출 보고
9월 15 2015
엑셀(EXCEL) – Pivot Table을 이용한 수업 중복 체크 및 몇가지 팁
엑셀에서 데이터와 문서라는 개념을 정립하고 시작하지 않으면 초기의 작은 데이터들은 문제가
없지만 데이터의 양이 많아지면 관리의 문제가 생깁니다. 저의 데이터와 문서라는 개인적인 구분은
열의 개념을 필드로 보고 행을 데이터로 정의합니다. 아래 질문에 첨부된 이미지 처럼 된 부분을 저는
문서라고 정의하고 일을 하고 있습니다. 사람이 보기 편한 데이터의 집합이지요.
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3528009
(중복 되는 것을 확인하는 방법이 있을까요?)
이 팁의 첨부된 그림처림 왼쪽 부분은 문서, 오른쪽 부분을 데이터라 정의하고 시작해 봅시다.
위의 질문의 그림처럼 문서로 보고 데이터를 분리하고 해석하려면 상당히 많은 고민을 하고 한계가
있는 것도 사실입니다. 생각을 바꾸어서 이 문서를 데이터로 만들어 봅시다. 필드로 교수, 시간, 요일
내용으로 4개의 필드를 만들고 데이터를 입력해 봅니다.
일단 왼쪽과 같이 중복된 항목은 입력하지 않고 A교수의 요일별 시간별 강의대상을 입력해 봅시다.
그런데 엑셀보고 일을 시키려면 사람이 보기 좋은 것 보다는 컴퓨터가 보기 좋고? 처리하기 쉽도록
데이터형식으로 만들어 주어야 합니다. 몇 교수님의 내용이면 그냥 채우기하면 좋겠지만 사람이
많이지면 채우는 것도 힘들어집니다. 이제 게을러져야 합니다.^^;;; 자동채우기 루틴입니다.
내용을 보시면 아시겠지만 채워야할 영역과 그 영역의 끝을 판단할 컬럼을 선택해서 채우는 것입니다.
Option Explicit
Sub Fill_Data()
Dim RngCel As Range
Dim OffsetCol As Integer
Set RngCel = Application.InputBox(“시작셀 선택”, , Type:=8)
OffsetCol = InputBox(“비교 칼럼 입력”)
Do
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until IsEmpty(ActiveCell.Offset(0, OffsetCol).Value)
End Sub
반대로 데이터들을 보기좋게 문서화 하기 위한 루틴입니다. 아래로 중복되는 행을 지워서 보기좋게
문서화하는 과정입니다. 이것보다 더 사람이 보기 좋은 것은 질문란의 이미지와 더 비슷하겠지요.
Sub UnFill_Data()
Dim TempStr As String
Dim RngAll As Range
Dim RngCell As Range
Set RngAll = Application.InputBox(“영역 선택”, , Type:=8)
TempStr = “초기값”
For Each RngCell In RngAll
If TempStr = RngCell.Value Then
If Len(RngCell.Offset(1, 0).Value) > 0 Then
RngCell.Value = “”
End If
ElseIf TempStr <> RngCell.Value Then
TempStr = RngCell.Value
End If
Next
Set RngAll = Nothing
Set RngCell = Nothing
End Sub
이제 위 문제를 다른 시각으로 해석해 봅니다. 댓글에 좋은 내용이 담기고 상당한 논리적 접근이 필요한데
4가지 정도는 2^n 16개로 쉽지만 몇 개가 더 늘어나면 논리도 논리이고 힘들어 지는 것이 사실입니다.
그래서 엑셀의 기능의 종결자라고 하는 Pivot을 이용해 봅니다. 논리는 합계가 1보다 크면 중복이라는 것을
잘 활용해 무엇이 중복이 되는지를 파악해야 합니다.
Sub CreatePivotTable()
Dim pvtPCache As PivotCache
Dim pvtPTable As PivotTable
Dim pvtFld As PivotField
Dim shtSheet As Worksheet
Dim rngStart As Range
Set rngStart = Sheets(“Data”).[A2]
‘ 기존 중첩체크용 시트 삭제
For Each shtSheet In ThisWorkbook.Sheets
If shtSheet.Name = “PivotSheet” Then
Application.DisplayAlerts = False
shtSheet.Delete
Application.DisplayAlerts = True
End If
Next shtSheet
‘ 새로운 시트 작성
Worksheets.Add.Name = “PivotSheet”
Set pvtPCache = ActiveWorkbook.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=rngStart.CurrentRegion.Address)
Set pvtPTable = pvtPCache.CreatePivotTable _
(TableDestination:=Sheets(“PivotSheet”).[A1], _
TableName:=”중첩체크”)
‘ 피봇 구성
With pvtPTable
.PivotFields(“내용”).Orientation = xlRowField
.PivotFields(“내용”).Position = 1
.PivotFields(“요일”).Orientation = xlColumnField
.PivotFields(“요일”).Position = 1
.PivotFields(“시간”).Orientation = xlColumnField
.PivotFields(“시간”).Position = 2
.AddDataField .PivotFields(“교수”), “개수:교수”, xlCount
‘ 전체요약 숨기기
.RowGrand = False
.ColumnGrand = False
End With
‘ 소계 부분 숨기기
With pvtPTable
For Each pvtFld In .PivotFields
pvtFld.Subtotals(1) = True
pvtFld.Subtotals(1) = False
Next pvtFld
End With
End Sub
해석하면 내용(반), 요일, 시간이 중복되는 교수님의 합을 구하는 것이 핵심입니다. 이렇게 되면 교수님이
몇 분으로 늘어나더라고 피벗 돌려서 중복되는 부분을 찾아 수정해 주면 됩니다. 교수님이 6분만 되어도
64가지 조건이 생기니 이것을 엑셀로 조건을 분리하는 것이 여간 힘든 일이 아닌 것을 알 수 있습니다.
피봇테이블에서 1보다 큰 숫자를 더블 클릭하면 중복된 교수님의 중복된 내용을 확인할 수 있습니다.
주저리 주저리 많이 써 놓았는데 문제를 바라보는 시각을 조금만 달리하면 데이터를 잘 활용할 수 있지만
문서로 보기 좋게 정리해 놓으면 보기는 좋은데 나중에는 가공하기가 힘들다는 것입니다. 그래서 서두에
써 놓았지만 데이터를 정리하는 시트는 시트대로 정리 후 이 데이터를 기반으로 가공하는 것이 훨씬 더
능률적이다는 것입니다.
첨부 화일 : 20150915-수업시간표 작성(중복금지체크)
By vinipapa • 무른모 • 0 • Tags: Pivot, 엑셀, 중복 제거, 중복 체크, 채우기, 피봇