4월 6 2015
엑셀(EXCEL) – 일정한 간격의 행과 임의의 열들을 추출하는 법
http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=266028&page=2&sca=&sfl=&stx=&spt=0&page=2&comment_page=last&cwin=#c_266501
데이터에서 일정한 간격의 행과 또 다른 일정 간격의 열을 추출하는 팁을 올렸는데 댓글에서 초코코님이
일정한 간격의 행에서 랜덤한 열들을 추출할 수 없는지가 문의가 있었습니다. 쉽게 생각해서 접근했는데
Listbox의 열의 한계가 10개 임으로 Offset함수를 사용할 경우 List중간 중간이 비어서 보기도 싫고
내용도 많이 들어가지 못해서 이 랜덤한 열을 어떻게 처리할 지 고민하다가 10년은 늙은 듯 해요… ㅠㅠ
자! 아래 내용 설명 들어갑니다. 코드는 짧지만 코드 처리 부분이 너무 힘들었어요.
우선 개발도구> Visual Basic 선택하시고 UserForm1을 하나 만듭니다.
Listbox1, Listbox2, Textbox1, Commandbutton1, Commandbutton2, Label1을 UserForm1에 만듭니다.
각각의 내용에 아래 함수 붙여 넣으시고 실행하시면 됩니다. 자료는 INT(RAND()*10000)으로 생성함.
Listbox1의 속성창에서 MultiSelect 는 fmMultiSelectMulti로 선택합니다. 다중 선택을 위해서입니다.
Listbox2의 ColumnCount는 10으로 최대한 주고, ColumnWidths는 60pt로 전체를 다 조정합니다.
Option Explicit
‘ 아래 함수에서 참조할 내용을 public으로 정의해서 사용합니다.
Public row_cnt As Integer, col_cnt As Integer, sel_cnt As Integer
‘ 사용자 정의폼을 초기화 합니다.
Private Sub UserForm_Initialize()
Dim i As Integer
Dim rng As Range
Sheets(“Data”).Select
‘ 데이터가 들어간 행의 갯수를 구함
row_cnt = Application.CountA(Range(“A1”, Range(“A1”).End(xlDown)))
‘ 데이터가 들어간 열의 갯수를 구함
col_cnt = Application.CountA(Range(“A1”, Range(“A1”).End(xlToRight)))
‘ Listbox1에 추출할 데이터 내용 추가
For i = 0 To col_cnt – 1
‘ A1셀에서 오른쪽으로 전체 열의 수만큼 이동하면서 추가
‘ 추출할 내용을 Listbox1에 추가하는 루틴임.
For Each rng In Range(“A1”).Offset(0, i)
UserForm1.ListBox1.AddItem rng
Next rng
Next i
‘ Time은 항상 선택되므로 선택을 기본으로 함
UserForm1.ListBox1.Selected(0) = True
End Sub
‘ Data 추출 루틴입니다.
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, k As Integer, ccnt As Integer, runit As Integer
runit = UserForm1.TextBox1.Value
i = 0
j = 0
k = 0
ccnt = 0 ‘ 리스트 박스에 나타날 위치를 정해주는 변수, 중간에 값들이 비어서 offset함수만 사용하면
‘ 데이터가 리스트 박스 중간중간이 비어서 보기 싫고 Listbox가 10열밖에 Data를 넣을 수 없어
‘ 효율이 떨어짐
sel_cnt = 0 ‘ Listbox1에 선택되어진 리스트의 갯수
‘속도를 빠르게 하기 위해서 업데이트를 하지 않고 추출 진행
Application.ScreenUpdating = False
For i = 0 To UserForm1.ListBox1.ListCount – 1
If UserForm1.ListBox1.Selected(i) = True Then
sel_cnt = sel_cnt + 1 ‘ 선택된 리스트의 갯수를 확인, Listbox2의 위치 선정을 위해 계산
End If
Next i
‘ 선택한 데이터가 10개가 넘으면 경고
If sel_cnt > 10 Then
MsgBox “선택한 데이터가 10개가 넘어요”
Exit Sub
End If
UserForm1.ListBox2.Clear ‘ 기존 추출된 Data 삭제
UserForm1.ListBox2.AddItem “” ‘ 추출할 데이터 제목 최상단에 추가
‘ 제일 힘든 루틴이었어요. Listbox 열의 크기가 10개 밖에 넣질 못해서 그냥 offset로 데이터를 추출할 수는 있지만
‘ 선택되지 않은 데이터의 열들이 비고 10이 넘어가는 데이터는 추출을 하지 못해서 로직 짜느라 10년은 늙은 듯 …
‘ 더욱이 추출하는 데이터가 랜덤이라 수열을 만들 수도 없고 해서 ㅠㅠ
For j = 0 To UserForm1.ListBox1.ListCount – 1
If UserForm1.ListBox1.Selected(j) = True Then
ccnt = (ccnt Mod sel_cnt) + 1 ‘ 핵심 루틴, 잘 해석해서 보세요
UserForm1.ListBox2.List(0, ccnt – 1) = Range(“A1”).Offset(0, j)
End If
Next j
‘ 데이터를 추출하는 루틴입니다. 위는 제목 행을 추출하는 루틴이구요.
‘ 첫 행을 임의로 추가 추출하고 싶으시면 runit – 1 부분을 0으로 대치하시면 됩니다.
For i = runit – 1 To row_cnt Step runit
UserForm1.ListBox2.AddItem “”
For j = 0 To UserForm1.ListBox1.ListCount – 1
If UserForm1.ListBox1.Selected(j) = True Then
ccnt = (ccnt Mod sel_cnt) + 1 ‘ 핵심 루틴, 잘 해석해서 보세요
UserForm1.ListBox2.List(k + 1, ccnt – 1) = Range(“A2”).Offset(i, j)
End If
Next j
k = k + 1
Next i
End Sub
‘ 추출된 데이터를 시트에 뿌려줍니다.
Private Sub CommandButton2_Click()
Dim i As Integer, j As Integer
i = 0
j = 0
‘ 속도를 빠르게 하기 위해서 업데이트 제한, 아래를 주석 처리하면 데이터가 넣어지는 것이 보임
Application.ScreenUpdating = False
‘ 추출할 데이트를 담을 시트 선택
Sheets(“ExtItem”).Select
‘ 기존 추출된 데이터 삭제
Range(“A1”, Range(“A1”).End(xlToRight)).End(xlDown).Clear
‘ 추출한 데이터 시트에 넣기, 자주 사용하는 루틴이므로 기억해 두면 좋음
For i = 0 To UserForm1.ListBox2.ListCount – 1
For j = 0 To UserForm1.ListBox2.ColumnCount – 1
Cells(i + 1, j + 1) = UserForm1.ListBox2.List(i, j)
Next j
Next i
‘ 짠~하고 업데이트된 데이터 보이기
Application.ScreenUpdating = True
Unload UserForm1
End Sub
첨부자료) 20150406-일정행-임의열 데이터 추출
전체 소스는 위 내용이므로 직접 실습하시면서 만들어 보시는 것도 실력향상에 도움이 될 것 같네요.
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에 넣으면 되기 때문에 커다란 의미가 없더군요. 지금까지 여러 자료를
찿아가면서 완벽하게 해서 올리려 했지만 아직은 역부족입니다. 그래도 여기까지 올려 두면 더
훌륭한 분들이 추가해서 멋지게 만들어 주시리라 믿고 올립니다.
By vinipapa • 무른모 • 0 • Tags: WateMark, 보안, 엑셀, 워트마크