9월 2 2015
엑셀(EXCEL) – 일정 영역에서 행별 중복항목 제거 및 추출 방법
아무거나 질문 게시판에 엑셀관련 아래와 같은 무시 무시한 질문과 답변이 올라왔습니다.
해석하면 자동으로 가로로 된 영역에서 중복 값을 제거하고 자기 영역에 다시 복사하여
붙이기를 하는 매크로입니다. 머리가 아프지만 저의 삽질 본능을 깨우는 내용입니다. ㅠㅠ
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3517395
([excel] 해당 코드에서 selection에서 자꾸 에러가 납니다. 원인분석을 부탁드립니다.)
엑셀은 사실 숫자를 다루기도 하지만 데이터를 더 많이 다루는 프로그램입니다. 자료를 작성
할 때는 데이터베이스처럼 필드 개념의 열과 데이터 개념의 행으로 보통 무의식적으로 만듭니다.
그래서 엑셀 내장 함수에도 아래로 입력된 데이터에 대해서는 중복 항목 제거하라는 기능을
고급필터에서 사용가능하도록 되어 있는데 행으로 된 데이터에 대해서 중복항목을 제거하려면
위의 내용처럼 정말 수작업이 많이 필요합니다.
특히나 중복 항목이라는 것은 데이터의 위치가 필요 없고 그 데이터만 필요하고 내용 중 빈셀도
의미 없는 데이터이기 때문에 처리를 해서 없애 버리고 자료를 구하는 것이 일반적인 상식이라고
생각합니다. 그래서 제가 예전에 찾아 쓰던 모듈을 응용하여 함수를 만듭니다. 빈 셀도 자료라고
처리해야 할 필요가 있을 때는 if 문을 제거하시고 사용하시면 됩니다.
모듈을 하나 만드시고 아래 식을 붙여 넣습니다.
Option Explicit
Function UniqItemRng(SelRng As Range) As String
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, item
Dim UniqStr As String
Set AllCells = SelRng
On Error Resume Next
For Each Cell In AllCells
If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
‘ Add method의 2번째 인자는 문자열이어야만 함
NoDupes.Add Cell.Value, CStr(Cell.Value)
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
UniqStr = UniqStr & “:” & item
Next item
UniqItemRng = UniqStr
Set Cell = Nothing
End Function
위 내용은 이해하실 필요는 없고 해석을 하자면 가로나 세로 영역이 선택되면 그 영역의 내용을
중복 항목을 제거하고 자료를 정렬해서 UniqStr이라는 변수에 차곡차곡 붙여 넣는 것입니다.
중간에 구분자(“:”)가 중요한 역할을 합니다. 제가 올린 팁에서 보시면 왜 넣었는지 이해하실
것입니다. “:”는 임의로 넣은 문자이니 엑셀 자료에서 잘 사용하지 않는 문자열로 대치하십시오.
이렇게 하면 상기의 스샷과 같이 특정 셀에서 =UniqItemRng라고 하시면 일반 엑셀 내장함수와
같이 영역을 선택하라고 하면 영역을 선택해주면 해당 셀에 중복자료를 표시해 줍니다. 다른
엑셀 시트에서 사용하시려면 .xla로 추가해서 사용하세요. 추가하는 방법은 구걸하세요 ^^;;;
그 다음 버튼 하나 만드시고 아래 서브 루틴을 버튼에 연결하시면 =UniqItemRng 함수가 사용된
셀의 오른쪽에 중복 항목들이 주르륵 나타납니다. 위의 매크로처럼 왼쪽 전체를 지우고 처리할 수도
있겠지만 그냥 예시로 나타내었으니 알아서 수정해서 사용하세요.
Private Sub CommandButton1_Click()
Dim TempStr As String
Dim RngStr As String
Dim intNum As Integer
Dim NumCnt As Integer
Dim RngCel As Range
Dim RngRef As Range
NumCnt = 0
TempStr = “”
‘ 검색할 셀의 조건을 셀을 클릭해서 선택
Set RngRef = Application.InputBox(“셀 선택”, , Type:=8)
‘ 속도를 위하여 스크린 업데이트 하지 않음
Application.ScreenUpdating = False
‘ 검색할 영역에서 선택된 셀과 같은 조건이 있으면 카운트
For Each RngCel In RngRef
RngStr = RngCel.Text
For intNum = 1 To Len(RngStr)
If Mid(RngStr, intNum, 1) <> “:” Then
TempStr = TempStr + Mid(RngStr, intNum, 1)
RngCel.Offset(0, NumCnt).Value = TempStr
Else
‘ 열의 위치 수정
NumCnt = NumCnt + 1
‘ 임시 문자열 초기화
TempStr = “”
End If
Next intNum
‘ 열의 위치 리셋
NumCnt = 0
Next
‘ 스크린 업데이트 진행
Application.ScreenUpdating = True
End Sub
위 내용을 보시면 간단하지만 이 영역을 자동화하려는 시도를 많이 해봤는데 더 복잡할 것 같고
엑셀의 내장함수의 고급 필터와 같은 방법으로 영역 선택해서 같은 행의 위치에 중복 데이터를
출력하도록 만들었습니다. 물론 코드 하나 더 넣어서 출력 위치도 선택할 수 있지만 크게 의미가
있을 것 같지 않아서 기능을 넣지 않았습니다.
하나의 문제를 보고 해결하는데 많은 고민을 하고 시행착오도 많이 겪습니다. 이런 아이디어가
괜찮을까? 저런 아이디어가 괜찮을까? 이 팁을 읽고 실무에서 잘 사용하도록 코드를 간결하게
만들어야지하면서 업무 중간 중간에 생각날 때마다 코드 작성해서 실행하고 무지 막지한 에러!
가끔씩 무한루프에 빠져 저장안한 코드 다 날아가고 … 여튼 재미있는 작업들입니다.
첨부 화일 : 20150902-일정 영역에서 행별 중복항목 제거 및 추출 방법
9월 3 2015
엑셀(EXCEL) – 다대다(多對多) 항목 역전개(기준항목 변경)
세상이 발전?함에 따라 내용도 많아지고 서로 경쟁적으로 살아가다 보니 여러 자료들이
처음 설계될 때 미처 생각하지 못한 문제들이 나타나고 비대해져 버린 데이터들을 다시
역으로 가공하려고 하면 엄두도 안나는 일에 포기하고 마는 수가 있습니다.
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3521638
경쟁 구도의 회사들을 잘 정리해 놓았는데 이것을 다시 기준을 바꾸어 새로 작성할려고하니
정말 엄두도 안나는 데이터에 포기하고 싶으셨는지 질문에 ㅠㅠ라고 눈물까지 흘리십니다.
일단 국내의 회사들도 무지 많을텐데 자료가 정리되지 않았다고 가정하여 진행을 합니다.
제가 이전에 올렸던 팁들에서 유용하게 사용하던 중복항목 제거 함수를 조금 더 발전시켜서
아래와 같이 만들었습니다. 참조 영역을 설정하고 중복제거된 데이터를 출력할 위치를 선택
바로 리스트를 만들 수 있도록 하였습니다.
Option Explicit
Sub ExtUniqItemRng()
Dim TempStr As String
Dim intNum As Integer
Dim NumCnt As Integer
Dim AllCells As Range, 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 = Application.InputBox(“추출 영역을 선택”, Type:=8)
Set TgtCel = Application.InputBox(“결과값을 저장할 셀을 선택”, Type:=8)
Set AllCells = SelRng
Application.ScreenUpdating = False
On Error Resume Next
For Each Cell In AllCells
If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
‘ Add method의 2번째 인자는 문자열이어야만 함
NoDupes.Add Cell.Value, CStr(Cell.Value)
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
UniqStr = UniqStr & “:” & item
Next item
NumCnt = 0
TempStr = “”
For intNum = 1 To Len(UniqStr)
If Mid(UniqStr, intNum, 1) <> “:” Then
TempStr = TempStr + Mid(UniqStr, intNum, 1)
TgtCel.Offset(NumCnt – 1, 0).Value = TempStr
Else
NumCnt = NumCnt + 1
TempStr = “”
End If
Next intNum
Set Cell = Nothing
Application.ScreenUpdating = True
End Sub
위 루틴을 실행해서 국내 회사들의 중복 항목을 제거해서 리스트를 만듭니다. 물론 리스트가
만들어져 있으면 이 루틴은 생략하시고 진행하시면 됩니다. 이제 경쟁회사들의 리스트를 선택
해외 경쟁사들을 추려내는 루틴입니다.
Sub ExtCompetitionCom()
Dim i As Integer, j As Integer
Dim rcnt As Integer, ccnt As Integer, ColCnt As Integer
Dim RCel As Range
Dim Ccel As Range
Dim RngCel As Range
Dim ComList As Range
rcnt = Application.CountA(Range(“A1”, Range(“A1”).End(xlDown)))
Set ComList = Application.InputBox(“국내회사 영역을 선택”, Type:=8)
ColCnt = 0
ccnt = ComList.Rows.Count – 1
Application.ScreenUpdating = False
For Each Ccel In ComList
For i = 2 To rcnt
For j = 2 To ccnt
If Ccel.Value = Cells(i, j).Value Then
Ccel.Offset(0, ColCnt + 1).Value = Cells(i, 1).Value
End If
Next j
ColCnt = ColCnt + 1
Next i
ColCnt = 0
Next
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Call ExtUniqItemRng
End Sub
Private Sub CommandButton2_Click()
Call ExtCompetitionCom
End Sub
이렇게 다 해결해서 올리면 간단해 보이는데 이 루틴을 최적화시키는 과정에서 머리 쥐납니다.
루틴은 머리에서 맴도는데 생각처럼 잘 되지 않으면 담배도 못피는 저는 쓴 커피 한 잔 마시고
돌아와서 한 번 더 생각 해 보면 어느 정도 실마리가 보이더군요.
첨부 화일 :20150903-다대다 항목 역전개
By vinipapa • 무른모 • 0 • Tags: 다대다 역전개, 엑셀, 역전개