4월 9 2015
엑셀(EXCEL) – 뚫리지 않는 방패와 뭐든지 뚫을 수 있는 창 만들기
(예시를 위해 WaterMark의 색을 진하게 사용했습니다)
소스 ) 20150409-Watermark
모순! 디지털에서는 영원이라 할지라도 뚫리지 않는 방패를 만들 수 없다고 봅니다.
항상 0과 1로 조합된 데이터를 가공하고 비밀번호나 기타 어떠한 경우에라도 원래의
자료 생산자가 들어갈 수 있는 방법을 마련해 놓아야 하니까요?
엑셀화일을 지정된 컴퓨터에서만 열 수 있게 하는 법
http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=265227
공유화일의 IP, 사용자 체크하여 열기, 편집여부 및 로그인, 아웃 기록
http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=265837
사용자의 HDD ID를 체크해서 공유 문서의 접근 여부를 확인해서 보안을 1차로 하고
IP, LogOn 정보를 확인해서 2차로 보안을 걸어 문서의 편집, 열람 여부 권한을 설정해서
관리를 하는데 나쁜 경우 카메라로 자료를 사진으로 찍거나 아니면 스크린 캡쳐를 해서
접근한 자료를 가져가는 경우가 있다고 이 문제를 해결할 수 없는지 문의가 있었습니다.
참 어려운 문제입니다. 웹이나 이런 경우는 ActiveX를 덕지 덕지 깔아서 스크린 캡춰를 하지
못하게 하거나 웹의 백그라운드로 이미지를 깔아서 사진 문제로 어떻게든 해결할 수 있는데
엑셀의 경우 참 난감한 문제이더군요.
아이디어를 생각하고 구걸신에게 구걸?해 봤습니다. 역시나 구걸신은 현명하게 답해주더군요.
WaterMark를 까는 것입니다. 보이는 셀마다 로그인한 사용자, 셀정보, 날짜를 넣어서 누가
언제 어디 부분을 사진을 찍더라고 카피를 하더라도 WaterMark가 보이게 하는 것이지요.
물론 아직까지 해결하지 못한 부분이 많습니다. 정식으로 프로그램을 배워서 작성하는 것이
아니라 취미로 하다보니 능력 부족이 그 이유입니다. 우선 WaterMark를 하나 하나 지우고
복사하고 사진을 찍으면 답이 없습니다. (이 부분 누가 아이디어 좀 주세요. 굽신 굽신)
두번째 속도가 조금 느립니다. 셀을 계산해서 Shape를 이용 WaterMark를 뿌리기 때문이고
세번째 마우스의 활용 용도가 떨어집니다. Shape를 이용해서 셀 위에 뿌려놓기 때문에
드래그를 통한 선택이 힘들고 함수 입력시에도 클릭을 통한 위치 입력이 힘들어요.
그래서 이 팁의 최종 사용 목적은 정형화된 Form이 있고 다른 시트에서 계산된 자료를
취합하여 보여주는 보고서 폼에 적합합니다. 물론 속도를 무시하고 전체 Sheet에 적용해도
무방하지만 무리가 있을 것 같습니다.
우선 ThisWorkbook을 더블 클릭해서 아래 코드를 넣어줍니다.
이 Workbook에서는 마우스의 오른쪽 클릭을 제한합니다. 단축키를 사용하는 것은 가능해요.
필요하지 않으면 아래 두 함수를 지우면 됩니다. 사실 마우스를 사용해도 대부분이 키보드를
통해서 사용해야 할 것입니다. 그래서 정형화된 폼에 데이터만 변할 때 사용하라는 것입니다.
Option Explicit
‘ 이 Workbook에서는 마우스의 이용을 제한합니다.
Private Sub Workbook_Activate()
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next
End Sub
‘ 이 Workbook을 떠나면 마우스가 오른쪽 클릭이 활성화됩니다.
Private Sub Workbook_Deactivate()
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = True
Next
End Sub
‘ 새로운 Sheet를 만들어 복사할 수 없도록 합니다. 그냥 넣어 두었어요.
‘ 다른 Workbook에다 복사하면 할 수 없습니다? 그래도 WaterMark는 복사되고
‘ Macro는 복사되지 않아서 이 부분을 크릭해서 지우려 하면 에러로 지우지 못함.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
ActiveSheet.Delete
MsgBox “새로운 시트를 생성할 권한이 없습니다! “, 16
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Module을 하나 만드시고 아래 코드를 넣습니다. WaterMark는 위의 팁을 이용해서
사용자 Logon 정보를 넣고 사용하시면 됩니다. 조금 응용하면 IP도 넣을 수 있겠지요.
오늘은 Full Source로 올려 드리지 못하고 나름대로 응용해서 잘 사용해 주세요.
Option Explicit
Const watermark As String = “hkyoon”
Sub WatermarkShape()
Dim cll As Range
Dim rng As Range
Dim ws As Worksheet
Dim shp As shape
Set ws = ActiveSheet
‘ WaterMark가 들어가 영역입니다.
Set rng = ws.Range(“A1:S28”) ‘Set range to fill with watermark
Application.ScreenUpdating = False
For Each shp In ws.Shapes
shp.Delete
Next shp
For Each cll In rng
Set shp = ws.Shapes.AddShape(msoShapeRectangle, 5, 5, 5, 5)
With shp
.Left = cll.Left
.Top = cll.Top
.Height = cll.Height
.Width = cll.Width
.Name = cll.address
‘ 두가지 순환문을 속도 체크해 보니 if문이 근소하게 빠르게 나타남
‘ Select Case cll.Row Mod 3
‘
‘ Case 0
‘ .TextFrame2.TextRange.Characters.Text = cll.address
‘ Case 1
‘ .TextFrame2.TextRange.Characters.Text = watermark
‘
‘ Case 2
‘ .TextFrame2.TextRange.Characters.Text = Format(Now(), “YYYYMMDD”)
‘
‘ End Select
‘ 여기에 WaterMark를 넣는 루틴입니다.
If cll.Row Mod 3 = 0 Then
.TextFrame2.TextRange.Characters.Text = cll.address ‘ 셀 위치 정보
ElseIf cll.Row Mod 3 = 1 Then
.TextFrame2.TextRange.Characters.Text = watermark ‘Logon 사용자
Else ‘현재 날짜
.TextFrame2.TextRange.Characters.Text = Format(Now(), “YYYYMMDD”)
End If
.TextFrame2.TextRange.Font.Name = “Tahoma”
.TextFrame2.TextRange.Font.Size = 10
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.WordWrap = msoFalse
.TextFrame.Characters.Font.ColorIndex = 15
.TextFrame2.TextRange.Font.Fill.Transparency = 0.7 ‘ WaterMark색의 진하기?
.Line.Visible = msoFalse
.OnAction = “‘SelectCell “”” & ws.Name & “””,””” & cll.address & “””‘”
With .Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Transparency = 1
.Solid
End With
End With
Next cll
Application.ScreenUpdating = True
End Sub
Sub SelectCell(ws, address)
Worksheets(ws).Range(address).Select
End Sub
정형화된 Form시트에 이 코드를 삽입합니다. ScrollArea는 사용자가 작업할 공간을 할당해 줍니다.
이 영역 외에는 입력도 스크롤도 할 수 없어 항상 WaterMark가 나타납니다.
Private Sub Worksheet_Activate()
WatermarkShape
ActiveSheet.ScrollArea = “A1:S28”
End Sub
배경으로 이미지를 깔고 통합 문서 보호와 공유를 하면 백그라운드에 WaterMark를 넣으면 되지만
내용을 복사해서 다른 Sheet에 넣으면 되기 때문에 커다란 의미가 없더군요. 지금까지 여러 자료를
찿아가면서 완벽하게 해서 올리려 했지만 아직은 역부족입니다. 그래도 여기까지 올려 두면 더
훌륭한 분들이 추가해서 멋지게 만들어 주시리라 믿고 올립니다.
4월 13 2015
엑셀(EXCEL) – 임의 영역에서 중복된 데이터 추출 및 데이터 가공
소스) 20150410-UniqueItemSort
우리가 엑셀을 다루면서 특히 시험데이터 등에서 중복되는 데이터들이 많이 나타납니다.
반복 시험을 하는 경우나 생산 현장의 생산 기록 등 중복되는 데이터들을 다루어야 할 경우
엑셀의 기본 기능을 가지고 중복데이터를 추출하면 되지만 이것이 행으로 이루어져 있질 않고
임의의 영역에 걸쳐 데이터가 존재할 때는 추출하기가 사실 막막하기만 것이 현실입니다.
일반인이 아닌 직장인?분들이야 쉽게 데이터를 추출할 수 있으시겠지만, 물론 일반 직장인도
여러가지 방법을 통해 반복적으로 하면 데이터를 추출해서 취합하실 수 있습니다. 그렇지만
조금만 아이디어를 가지고 하면 반복적인 일들을 한 번에 추출하고 가공이 가능하지요.
우선 엑셀의 기본 기능을 가지고 데이터 중에서 중복되는 데이터를 하나의 데이터로 추출하는
방법을 여러 가지로 해 봅니다. (엑셀 2007 기준) 2010버전은 제가 사용해 보지 못한 관계로
2010에 이 기능이 있을 수도 있습니다. 그러면 전 하루를 쓸 데 없는 데 힘 쓴 경우네요. ㅠㅠ
1. 우선 데이터 > 필터 – 고급 기능을 이용하는 경우
결과 : 다른 장소에 복사
목록 범위 : 원하는 영역을 선택
복사위치 : 복사될 위치를 선택
동일한 레코드는 하나만 선택
2. 데이터 > 중복된 항목 제거 기능 선택
3. 피벗 테이블 이용 : 삽입 > 피벗테이블 선택
표 또는 범위 선택
보고서 놓을 위치 : 기존 워크시트에서 셀 선택
4. 함수를 만들어서 내장? 함수를 이용하는 경우
엑셀 시트에 삽입 > ActiveX Control : 명령 단추 하나 삽입하고 모듈에 아래 코드 삽입
Sub FindUniqueValues()
Dim soruce As Range, targetcell As Range
Set soruce = Application.InputBox(“영역을 선택하세요”, Type:=8)
Set targetcell = Application.InputBox(“셀을 선택하세요”, Type:=8)
soruce.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=targetcell, Unique:=True
End Sub
이 정도가 기본 기능만을 사용해서 오직 같은 ‘행’에서 유일한 데이터를 추출하는 방법입니다.
물론 조금씩 내장함수와 기타 기능을 응용해서 추출하실 수 있는 방법은 다양할 것으로 보입니다.
아래는 위의 결과를 원본과 함께 순서대로 오른쪽으로 결과를 나열했습니다.
(원본) (1) (2) (3) (4)
그런데 추출된 데이터를 보면 몇 가지 문제점이 있습니다. 피폿을 이용한 경우를 빼고 데이터가
빈 셀을 포함해서 정렬이 되지 않고 빈셀이 중간에 나타나 보기가 싫어집니다. 물론 데이터를
정렬해서 보며 괜찮지만 번거러운 일이 아닐 수 없습니다.
그렇지만 위의 문제점은 그냥 번거러움의 문제지 기능의 문제는 아닙니다. 엑셀의 내장 기능을
사용한 경우 “열”으로만 나열된 데이터에서 유일한 데이터를 추출해 줍니다. 일정 영역에서
데이터를 추출하려면 그 영역을 복사하거나 해서 한 열 아래로 모두 맞추고 추출해야 하지요.
데이터가 얼마되지 않으면 이런 수고스러움을 감수하면 되겠지만 몇 만개가 되면 큰 일 입니다.
그리고 그 추출한 데이터를 가공하고 싶을 때 또 번거러운 작업과 내장 함수를 이용해서 추출하고
하는 것이 번거러워서 이 팁을 공유하고자 합니다. 하고자 하는 목적이 정확히 있으면 프로그램을
완전하게 했을텐데 일반적인? 직장인이 뭘 원하지 몰라서 프로세스 별로 분리해서 작성했습니다.
아래에 원본 소스 붙입니다.
Public Sel_Rng As Range
‘ combobox, listbox의 Object에 선택한 컬럼의 유일한 데이터 추출
Sub Uniq_Item_Sort(Obj As Object, Col_no 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
‘빈셀을 포함시키지 않음, 같은 열에서 빈 셀을 뺀 나머지 자동 선택
Set AllCells = Columns(Col_no).SpecialCells(xlTextValues)
On Error Resume Next
For Each Cell In AllCells
‘ Add method의 2번째 인자는 문자열이어야만 함
NoDupes.Add Cell.Value, CStr(Cell.Value)
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
Set Obj = Nothing
End Sub
‘ 응용법 : combobox, listbox의 Object에 선택한 영역의 유일한 데이터 추출
Sub Rng_Uniq_Item_Sort(Obj As Object, Sel_Rng As Range)
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, item
Set AllCells = Sel_Rng
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
Obj.AddItem item
Next item
Set Cell = Nothing
Set Obj = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, item
Set AllCells = Sel_Rng
On Error Resume Next
For i = 0 To UserForm1.ListBox1.ListCount – 1
For Each Cell In AllCells
If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
If Str(UserForm1.ListBox1.List(i, 0)) = Str(Cell.Value) Then
j = j + 1
End If
End If
Next Cell
UserForm1.ListBox1.List(i, 1) = j
j = 0
Next i
For i = 0 To UserForm1.ListBox1.ListCount – 1
ListBox1.List(i, 2) = Format((Val(ListBox1.List(i, 1)) / Val(ListBox1.ListCount)) * 100, “##.0”)
Next i
Set Cell = Nothing
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer, j As Integer
Dim targetcell As Range
Set targetcell = Application.InputBox(“영역을 선택하세요”, Type:=8)
Application.ScreenUpdating = False
For i = 0 To UserForm1.ListBox1.ListCount – 1
For j = 0 To UserForm1.ListBox1.ColumnCount – 1
targetcell(i + 1, j + 1) = UserForm1.ListBox1.List(i, j)
Next j
Next i
Application.ScreenUpdating = True
Unload UserForm1
‘ 메모리에서 지움
Set Sel_Rng = Nothing
End Sub
Private Sub ListBox1_Click()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, item
Set AllCells = Sel_Rng
‘속도를 위해 화면 업데이트 취소
Application.ScreenUpdating = False
On Error Resume Next
For Each Cell In AllCells
‘ 기존 색칠된 셀을 흰색으로 우선 되돌림
Cell.Interior.Color = vbWhite
If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
If Str(ListBox1.List(ListBox1.ListIndex, 0)) = Str(Cell.Value) Then
Cell.Interior.Color = vbGreen
End If
End If
Next Cell
Set Cell = Nothing
‘ 업데이트 시작
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
Sheets(“Data”).Activate
On Error Resume Next
Set Sel_Rng = Application.InputBox(“영역을 선택하세요”, Type:=8)
If Sel_Rng Is Nothing Then
Exit Sub
Else
Call Rng_Uniq_Item_Sort(ListBox1, Sel_Rng)
End If
End Sub
개발도구 > Visual Basic 선택하시고 UserForm1을 삽입합니다. Listbox1하나 만드시고
Column Count 3을 선택하고 Commandbutton1, Commanbutton2 만드시고 Userform1을
더블 클릭 하시고 위 코드 붙여넣기 하시면 됩니다.
엑셀 시트에서 개발도구 삽입 > ActiveX Control에 명령단추 하나 삽입하시고 더블 클릭
Load UserForm1
UserForm1.Show
이제 디자인 모드 해제하시고 명령 단추를 클릭하면 UserForm에 유일한 데이터만 보입니다.
그리고 Commandbutton1을 누르시면 유일한 데이터의 갯수와 전체 차지하는 비율을 보여주고
(물론 빈셀은 빼고 입니다. 필요하시면 코멘트 부분 제거하시고 사용하시면 됩니다.)
그리고 ListBox1의 리스트를 클릭하시면 그 데이터 있는 셀의 위치를 녹색으로 보여줍니다.
이 부분을 다양하게 응용하시면 업무하시는데 도움이 될거라고 봅니다. Commandbutton2를
누르시면 추출된 데이터를 필요한 위치에 뿌려 줍니다. 리스트 박스에 List를 가져오는 것과
Listbox 클릭을 잘 이용하시면 설정된 영역의 데이터를 어떤 식으로든 가공이 편할 것입니다.
제가 VBA Form을 가지고 작업하는 이유는 1차 가공된 데이터 들을 Form상에서 2차 가공이
편리하기 때문에 이 방법을 자주 사용하고 있습니다. 순수하게 데이터를 추출하시려고 하면
바로 하는 것이 좋지만 대분분의 데이터는 2차 가공이 필요하기 때문이죠.
By vinipapa • 무른모 • 0 • Tags: 엑셀, 유일 아이템, 중복 데이터