세상이 발전?함에 따라 내용도 많아지고 서로 경쟁적으로 살아가다 보니 여러 자료들이
처음 설계될 때 미처 생각하지 못한 문제들이 나타나고 비대해져 버린 데이터들을 다시
역으로 가공하려고 하면 엄두도 안나는 일에 포기하고 마는 수가 있습니다.
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-다대다 항목 역전개
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: 다대다 역전개, 엑셀, 역전개