::: 까만콩 빈이네 :::
까만콩 빈이네의 살아가는 이야기를 기록합니다
RSS
  • Home
20151006151939

10월 6 2015

엑셀(EXCEL) – 워드(Word)의 연동을 통한 사용자 정의 사전 구현(기능 다수 추가)

 

http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=290227
(엑셀(EXCEL) – 엑셀(Excel)과 워드(Word)의 연동을 통한 사용자 정의 사전 구현)

팁으로 올렸던 것을 이왕이면 실제 사용할 수 있고 편하게 사용하고자 수정해서 올립니다.
기존 것은 단순히 Excel에서 입력하고 Word에서 조회만 가능해서 두 프로그램을 실행하여
추가, 삭제 등을 해야 했으나 이 업그레이드 버전은 엑셀 파일을 열지않고 Word에서 단어들을
바로 추가, 수정 및 영문을 번역 단어로 전체 대치를 할 수 있도록 수정했습니다.

그리고 단어를 선택해서 바로 유저폼에서 조회할 수 있도록 하였습니다. 오른쪽 버튼을 누르면
팝업 메뉴를 구현(이것은 구걸…)하여 편의성을 올렸습니다. 일반적인 직장인?분이 MySQL이나
기타 DataBase프로그램을 이용하면 쉬울 것이라고 하지 말아주세요. 몰라서 안하는 것이 아니라
순수하게 Office Suite를 이용해서 이런 것도 할 수 있다는 것을 보여주는 것이기 때문입니다.

단어 대치 기능은 개별로 선택된 단어를 대치할 수도 있고 아래 붉은 글씨의 주의사항대로
문서 전체에서 등록된 단어들로 대치하는 기능입니다. 되돌릴 수 없는 기능이니 주의하세요.
쓰다 보니 되돌리기 기능이 너무 쉬워서 추가했습니다 ㅠㅠ.

Option Explicit

Private Sub CommandButton1_Click()

Dim i As Long

Dim fstr As String, sqlstr As String

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

If Len(UserForm1.TextBox1.Text) = 0 Then Exit Sub

fstr = “%” & UserForm1.TextBox1.Text & “%”

sqlstr = “select Word, Trans, Mean from [DicList$] where Word like ‘” & fstr & “‘”

Set rst = conn.Execute(sqlstr)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then
UserForm1.ListBox1.Clear
Exit Sub

End If

rst.MoveFirst

i = 0

With UserForm1.ListBox1

.Clear

Do
.AddItem
.List(i, 0) = rst!Word
.List(i, 1) = rst!Trans
.List(i, 2) = rst!Mean

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

End Sub

Private Sub CommandButton2_Click()

Dim i As Long

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

Set rst = conn.Execute(“select Word, Trans, Mean from [DicList$] “)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then Exit Sub

rst.MoveFirst

i = 0

With UserForm1.ListBox1

.Clear

Do
.AddItem
.List(i, 0) = rst!Word
.List(i, 1) = rst!Trans
.List(i, 2) = rst!Mean

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

‘ 검색할 값 초기화
TextBox1.Text = “”
TextBox2.Text = “”
TextBox3.Text = “”

End Sub

Private Sub CommandButton3_Click()

Dim sqlstr As String, fstr As String

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection

‘ 연결
conn.Open sConnString

fstr = Trim(UserForm1.TextBox1.Text)

If Len(fstr) = 0 Then Exit Sub

sqlstr = “SELECT * FROM [DicList$] WHERE Word='” & fstr & “‘”

Set rst = conn.Execute(sqlstr)

If rst.BOF Or rst.EOF Then

‘ 데이터 추가
sqlstr = “INSERT INTO [DicList$] VALUES (‘” & TextBox1.Text & “‘,'” &
TextBox2.Text & “‘,'” & TextBox3.Text & “‘)”

Call conn.Execute(sqlstr)
Else
MsgBox “동일 단어가 있습니다”

End If

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing

TextBox1.Text = “”
TextBox2.Text = “”
TextBox3.Text = “”

Call CommandButton2_Click

End Sub

Private Sub CommandButton4_Click()

Dim sqlstr As String, fstr As String, frstr As String
Dim tstr As String, mstr As String

Dim conn As ADODB.Connection
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection

‘ 연결
conn.Open sConnString

fstr = UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex, 0)

If Len(fstr) = 0 Then
MsgBox “단어를 선택하세요”
Exit Sub

End If

‘ 데이터 수정
frstr = UserForm1.TextBox1.Text
tstr = UserForm1.TextBox2.Text
mstr = UserForm1.TextBox3.Text

sqlstr = “UPDATE [DicList$] SET Trans = ‘” & tstr & “‘” & ” , Mean = ‘” & mstr & “‘” & ”
WHERE Word = ‘” & fstr & “‘”

Call conn.Execute(sqlstr)

‘ 디비를 변형적으로 업데이트
sqlstr = “UPDATE [DicList$] SET Word = ‘” & frstr & “‘” & ” WHERE Trans = ‘” & tstr &
“‘” & ” AND Mean = ‘” & mstr & “‘”

Call conn.Execute(sqlstr)

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing

TextBox1.Text = “”
TextBox2.Text = “”
TextBox3.Text = “”

Call CommandButton2_Click

End Sub

‘ 개별 단어 대치
Private Sub CommandButton5_Click()

Dim myRange As Range

Set myRange = ActiveDocument.Content

myRange.Find.Execute FindText:=UserForm1.TextBox1.Text, MatchCase:=True,
MatchWholeWord:=True, _
ReplaceWith:=UserForm1.TextBox2.Text, Replace:=wdReplaceAll

End Sub

‘ 사전에 등록된 단어 전체 대치
Private Sub CommandButton6_Click()

Dim i As Integer

Dim myRange As Range

Set myRange = ActiveDocument.Content

For i = 0 To UserForm1.ListBox1.ListCount – 1

myRange.Find.Execute FindText:=UserForm1.ListBox1.List(i, 0), MatchCase:=True,
MatchWholeWord:=True, _
ReplaceWith:=UserForm1.ListBox1.List(i, 1), Replace:=wdReplaceAll

Next i

End Sub

‘ 사전에 등록된 단어 전체 환원
Private Sub CommandButton7_Click()

Dim i As Integer

Dim myRange As Range

Set myRange = ActiveDocument.Content

For i = 0 To UserForm1.ListBox1.ListCount – 1

myRange.Find.Execute FindText:=UserForm1.ListBox1.List(i, 1), MatchCase:=True,
MatchWholeWord:=True, _
ReplaceWith:=UserForm1.ListBox1.List(i, 0), Replace:=wdReplaceAll

Next i

End Sub

Private Sub ListBox1_Click()

TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)

Call CopyToClip

End Sub
Module 하나를 추가해서 붙여넣기 합니다.

Option Explicit

Sub CopyToClip()

Dim obj As New DataObject
Dim Cliptxt As String

Cliptxt = UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex, 1)

obj.SetText Cliptxt

obj.PutInClipboard

End Sub
Sub Open_UserDic()

UserForm1.Show vbModeless

‘ 선택된 단어의 마지막 스페이스 문자 제거
UserForm1.TextBox1.Text = Trim(Selection.Text)

Dim i As Long

Dim fstr As String, sqlstr As String

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

If Len(UserForm1.TextBox1.Text) = 0 Then Exit Sub

fstr = “%” & UserForm1.TextBox1.Text & “%”

sqlstr = “select Word, Trans, Mean from [DicList$] where Word like ‘” & fstr & “‘”

Set rst = conn.Execute(sqlstr)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then
UserForm1.ListBox1.Clear
UserForm1.TextBox2.Text = “”
UserForm1.TextBox3.Text = “”

Exit Sub

End If

rst.MoveFirst

i = 0

With UserForm1.ListBox1

.Clear

Do
.AddItem
.List(i, 0) = rst!Word
.List(i, 1) = rst!Trans
.List(i, 2) = rst!Mean

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

End Sub

Sub BuildControls()

Dim oBtn As CommandBarButton

Dim oPopUp As CommandBarPopup
Dim oCtr As CommandBarControl

‘Make changes to the Normal template
CustomizationContext = NormalTemplate

‘Prevent double customization
Set oPopUp = CommandBars.FindControl(Tag:=”custPopup”)

If Not oPopUp Is Nothing Then GoTo Add_Individual

‘Add PopUp menu control to the top of the “Text” short-cut menu
Set oPopUp = CommandBars(“Text”).Controls.Add(msoControlPopup, , , 1)

With oPopUp
.Caption = “추가 기능”
.Tag = “custPopup”
.BeginGroup = True
End With

Set oBtn = oPopUp.Controls.Add(msoControlButton)

With oBtn
.Caption = “사용자 정의 사전”
.FaceId = 940
.Style = msoButtonIconAndCaption
.OnAction = “Open_UserDic”
End With

Set oBtn = Nothing

Add_Individual:
‘Or add individual commands directly to menu
Set oBtn = CommandBars.FindControl(Tag:=”custCmdBtn”)

If Not oBtn Is Nothing Then Exit Sub
‘Add control using built-in ID 758 (Boo&kmarks…)
Set oBtn = Application.CommandBars(“Text”).Controls.Add(msoControlButton, 758, , 2)

oBtn.Tag = “custCmdBtn”

If MsgBox(“This action caused a change to your Normal template.” _
& vbCr + vbCr & “Recommend you save those changes now.”, vbInformation +
vbOKCancel, _
“Save Changes”) = vbOK Then
NormalTemplate.Save
End If

Set oPopUp = Nothing
Set oBtn = Nothing

lbl_Exit:
Exit Sub

End Sub

Module 하나를 추가해서 붙여넣기 합니다. 코드가 충돌해서 Module을 분리하였습니다.

Option Explicit

Sub RemoveContent_MenuItem()

Dim oPopUp As CommandBarPopup
Dim oCtr As CommandBarControl

‘Make command bar changes in Normal.dotm
CustomizationContext = NormalTemplate

On Error GoTo Err_Handler

Set oPopUp = CommandBars(“Text”).Controls(“추가 기능”)

‘Delete individual commands on the PopUp menu
For Each oCtr In oPopUp.Controls
oCtr.Delete
Next

‘Delete the PopUp itself
oPopUp.Delete

‘Delete individual custom commands on the Text menu
For Each oCtr In Application.CommandBars(“Text”).Controls
If oCtr.Caption = “Boo&kmark…” Then
oCtr.Delete
Exit For
End If
Next oCtr

If MsgBox(“This action caused a change to your Normal template.” _
& vbCr + vbCr & “Recommend you save those changes now.”, vbInformation +
vbOKCancel, _
“Save Changes”) = vbOK Then
NormalTemplate.Save
End If

Set oPopUp = Nothing
Set oCtr = Nothing
Exit Sub

Err_Handler:

End Sub

추가> 문서 열고 닫을 때 사용자 정의 팝업 메뉴의 실행 및 제거 루틴이 빠졌어요.
저는 한 번 해서 계속 사용할 수 있어서 루틴을 깜빡 했습니다. 첨부된 화일에서 VBA Editor에서

ThisDocument 더블 클릭하시고 아래 코드 넣어세요.

Option Explicit

Private Sub Document_Close()

‘ 모듈이 오류가 나서  RemoveContentMenuItem를 RemoveContent_MenuItem로 바꾸세요.
Call RemoveContent_MenuItem

End Sub

Private Sub Document_Open()

Dim i As Long

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Dim sConnString As String
Dim sqlstr As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

Set rst = conn.Execute(“select Word, Trans, Mean from [DicList$] “)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then Exit Sub

rst.MoveFirst

i = 0

With UserForm1.ListBox1
.Clear

Do
.AddItem
.List(i, 0) = rst!Word
.List(i, 1) = rst!Trans
.List(i, 2) = rst!Mean

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

‘ 사용자 정의폼을 모달리스 즉 플로팅 윈도우로 뛰어서
‘ 사용자가 수정,입력을 하면서 사전 참조할 수 있도록 함
UserForm1.Show vbModeless

‘ 사용자 편의를 위해 어짜피 영어 사전이므로 영어를 기본으로 입력하게 함
UserForm1.TextBox1.IMEMode = fmIMEModeAlpha

‘ 사용자 팝업 메뉴 생성
Call BuildControls

End Sub

수정 첨부 화일 : 20151006 – 워드(Word)의 연동을 통한 사용자 정의 사전 구현(기능 다수 추가)

By vinipapa • 무른모 • 0 • Tags: 사용자 정의 사전, 엑셀(EXCEL), 워드(Word), 팁

20151005140307

10월 5 2015

엑셀(EXCEL) – 엑셀(Excel)과 워드(Word)의 연동을 통한 사용자 정의 사전 구현

 

매번 올리는 팁이 엑셀관련이라서 제 업무가 이 계통이라 생각하시는 분이 많으신가 봅니다.
오늘도 쪽지에 팁 관련 문의를 주셔서 나름대로 답변을 드렸는데 엑셀의 버전에 따라 동작을
안하는 루틴도 있는 모양입니다.

전 회사에서 지원된 버전이 2007버전이라 이것으로 팁란에 팁을 올려드리는데 다른 최신식?
버전에서 동작하지 않는 경우가 많은가 봅니다. 되도록이면 다 동작했으면 좋겠는데 환경이
열악하다 보니 제가 할 수 있는 부분은 답변을 드리도록 하겠습니다.

각설하고 매번 엑셀관련 팁만 올렸는데 이번에는 조금 더 발전시켜 오피스에서 엑셀, 파워포인트
다음으로 많이 사용하고 있다고 생각되는? 워드와의 콜라보를 통한 업무 향상 스킬에 대해서
조그마한 팁을 올려드리고자 합니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3545722
(책 번역 시 용어를 찾을 때마다 프로그램에 바로바로 추가할 수 있을까요?)

엑셀을 사용해서 번역문을 셀마다 입력하고 찾기/바꾸기를 해서 내장사전?을 만들어 사용할 수
있겠지만 제목처럼 번역문은 워드에다 직접 입력하고 단어를 찾아서는 엑셀에다 입력해서 서로
연동하면서 사용할 수 있도록 할 예정입니다.

우선 첨부된 그림처럼 엑셀 파일에다 단어와 뜻을 입력하여 저장을 합니다. 위치는 C:\에다
저장하는 것으로 하겠습니다. 포멧은 97-2003포멧으로 저장해 주세요. ADO를 사용하는데
연결 문자열이 2007버전이 제대로 동작하지 않아서 번거럽더라도 위 포멧으로 저장 바랍니다.
이제 워드 문서 하나 여시고 VBA Editor를 여시고 아래 루틴을 복사해 넣고 도구 > 참조에서
Microsoft AcitveX Data Objects 2.x Library를 추가해 주시기 바랍니다.

ption Explicit

Private Sub Document_Open()

Dim i As Long

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Dim sConnString As String
Dim sqlstr As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

Set rst = conn.Execute(“select 단어, 뜻 from [DicList$] “)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then Exit Sub

rst.MoveFirst

i = 0

With UserForm1.ListBox1
.Clear

Do
.AddItem
.List(i, 0) = rst![단어]
.List(i, 1) = rst![뜻]

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

‘ 사용자 정의폼을 모달리스 즉 플로팅 윈도우로 뛰어서
‘ 사용자가 수정,입력을 하면서 사전 참조할 수 있도록 함
UserForm1.Show vbModeless

‘ 사용자 편의를 위해 어짜피 영어 사전이므로 영어를 기본으로 입력하게 함
UserForm1.TextBox1.IMEMode = fmIMEModeAlpha

End Sub

간단하게 설명하면 문서가 열리면 C:\에 있는 UserDic.xls를 참조하여 UserFomr에다가 사전을
뛰우라는 명령입니다. UserForm1.Show vbModeless가 중요한데 이렇게 함으로써 사용자가 편집을
하면서 사전을 참조할 수 있도록 항상 Form이 최상단에 위치하도록 하는 것입니다.

UserForm 하나 만드시고 Command1, Command2, Textbox, Listbox 각각 하나 추가합니다.
그리고 아래 코드 붙여넣기합니다. Command1은 Textbox1의 내용을 와일드카드로 검색하고
Command2는 리프레시(초기화, 갱신) 버튼입니다.

Private Sub CommandButton1_Click()

Dim i As Long

Dim fStr As String, sqlstr As String

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

fStr = “%” & UserForm1.TextBox1.Text & “%”

sqlstr = “select 단어, 뜻 from [DicList$] where 단어 like ‘” & fStr & “‘”

Set rst = conn.Execute(sqlstr)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then Exit Sub

rst.MoveFirst

i = 0

With UserForm1.ListBox1

.Clear

Do
.AddItem
.List(i, 0) = rst![단어]
.List(i, 1) = rst![뜻]

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

End Sub

Private Sub CommandButton2_Click()

Dim i As Long

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sConnString As String

‘ 연결 문자열 : Excel 2003
sConnString = “Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=C:\UserDic.xls;”

‘ 새로운 연결과 레코드셋 설정
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset

‘ 연결
conn.Open sConnString

Set rst = conn.Execute(“select 단어, 뜻 from [DicList$] “)

‘ 데이터 체크
‘ 없으면 서브루틴 빠져 나감
If rst.BOF Or rst.EOF Then Exit Sub

rst.MoveFirst

i = 0

With UserForm1.ListBox1

.Clear

Do
.AddItem
.List(i, 0) = rst![단어]
.List(i, 1) = rst![뜻]

i = i + 1

rst.MoveNext

Loop Until rst.EOF

End With

‘ 연결 끊기와 메모리 비움
If CBool(conn.State And adStateOpen) Then conn.Close

Set conn = Nothing
Set rst = Nothing

‘ 검색할 값 초기화
UserForm1.TextBox1.Text = “”

End Sub

아래는 Listbox를 클릭하면 그 단어의 내용을 클립보드로 복사하는 루틴입니다. 결국 단어를
찾는다는 것을 그 뜻을 이용할 것이기 때문에 편의를 위해 넣은 코드입니다.

Private Sub ListBox1_Click()

Call CopyToClip

End Sub

VBA Editor에서 Module하나 추가하시고 아래 코드를 붙여넣기 합니다.

Option Explicit

Sub CopyToClip()

Dim obj As New DataObject
Dim Cliptxt As String

Cliptxt = UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex, 1)

obj.SetText Cliptxt

obj.PutInClipboard

End Sub

별로 어려운 내용이 아니지만 사실 업무를 하면서 굉장히 필요한 내용일 수도 있으므로 팁란에
올렸습니다. 추가로 검색/바꾸기 기능도 넣을 수도 있지만 워드에 충실한 기능이 있으므로
그 부분은 생략합니다.

첨부 화일 : 20151005 – 엑셀(Excel)과 워드(Word)의 연동을 통한 사용자 정의 사전 구현 

By vinipapa • 무른모 • 0 • Tags: Excel, Word, 사용자 정의 사전, 엑셀, 연동, 워드, 콜라보

20151002140048

10월 2 2015

엑셀(EXCEL) – 두 영역 비교하여 같은 값 추출 및 시트별로 분리

 

추석 연휴로 인해 며칠 지나지 않았는데도 벌써 내일 주말이 되었습니다. 별다른 일도 없고 해서
저번 아질게에 올라온 다중 영역 필터링에 대해 글을 쓰게 되었는데 아질게에 아무리 찾아보아도
관련 글이 보이지 않네요. 이제 늙으니 기억력에 문제가 생기는 …

저번에 팁란에 각 시트를 통합하고 그 통합된 시트에서 특정 데이터를 추출하는 법을 올렸습니다.
http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=286941
(엑셀(EXCEL) – 시트 통합, 월간년간보고서 작성 및 특정 자료(대리점) 추출)

이제 그 반대로 두 영역의 데이터를 상호 비교하여 같은 것이 있으면 추출하는 방법을 보겠습니다.
추출할 데이터가 몇 가지 되지 않으면 그냥 필터링을 해서 추가하고 또 필터링해서 추가하고 하면
되지만 예제에는 속도를 위해 몇 가지 데이터밖에 넣지를 않았지만 비교할 데이터가 몇백개 이상
넘어가면 수작업으로는 무리가 있습니다.

이제 VBA Editor 여시고 Module하나 만드시고 아래 코드를 복사하여 붙여넣기합니다.
코드 중간중간에 주석 달아놓았으니 필요한 부분을 수정, 첨삭하시어 사용하기 바랍니다.
한 루틴은 데이터를 비교하여 한 시트에 모아 주는 루틴이고 한 루틴은 각 데이터별로 시트를
만들어 분리해 주는 루틴입니다.

Option Explicit

Sub Ext_Same_Value()

Dim cnt As Integer

Dim rngCell As Range, rngTgt As Range
Dim rngR As Range, rngRef As Range

Dim tgt As Worksheet

‘ 경고 메시지 금지 및 속도를 위해 업데이트 중지
Application.DisplayAlerts = False
Application.ScreenUpdating = False

‘ 추출해서 붙여넣기할 데이터 시트가 기존에 있으면 삭제
For Each tgt In Worksheets
If tgt.Name = “ExtData” Then
tgt.Delete

End If
Next tgt

‘ 새 시트를 워크시트 제일 마지막에 ExtData라는 이름으로 추가
Set tgt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
tgt.Name = “ExtData”

‘ 추출할 데이터 영역과 추출할 참조 영역 설정
Set rngTgt = Worksheets(“Data”).Range(“B:B”).SpecialCells(xlTextValues)
Set rngRef = Worksheets(“Ref”).Range(“A:A”).SpecialCells(xlTextValues)

‘ 두 영역을 순환하면서 같은 데이터가 있으면 추출 시트에 복사
For Each rngCell In rngTgt

For Each rngR In rngRef

If rngCell = rngR Then

tgt.Range(“A1”).Offset(cnt, 0).Value = rngCell.Offset(0, -1).Value
tgt.Range(“A1”).Offset(cnt, 1).Value = rngCell.Offset(0, 0).Value
tgt.Range(“A1”).Offset(cnt, 2).Value = rngCell.Offset(0, 1).Value
tgt.Range(“A1”).Offset(cnt, 3).Value = rngCell.Offset(0, 2).Value

cnt = cnt + 1

Exit For

End If

Next rngR

Next rngCell

‘ 보기 좋게 자동 칼럼 맞춤
tgt.Columns.AutoFit

‘ 경고 메시지 및 업데이트 갱신
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub Ext_Same_Value_To_Sheet()

Dim cnt As Long

Dim rngCell As Range, rngTgt As Range
Dim rngR As Range, rngRef As Range

Dim tgt As Worksheet

‘ 데이터 영역과 참조 영역 선택
Set rngTgt = Worksheets(“Data”).Range(“B:B”).SpecialCells(xlTextValues)
Set rngRef = Application.InputBox(“분리할 참조 영역 선택”, Type:=8)

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets(“Ref”).Activate

For Each rngR In rngRef

‘ 추출할 데이터의 시트가 있으면 삭제
For Each tgt In Worksheets
If tgt.Name = rngR Then
tgt.Delete

End If
Next tgt

‘ 추출할 데이터의 시트를 데이터 이름으로 추가
Worksheets.Add after:=ActiveSheet
ActiveSheet.Name = rngR

‘ 제목행 만듦
With Range(“A1”)
.Offset(0, 0).Value = Sheets(“Data”).Range(“A1”).Offset(0, 0).Value
.Offset(0, 1).Value = Sheets(“Data”).Range(“A1”).Offset(0, 1).Value
.Offset(0, 2).Value = Sheets(“Data”).Range(“A1”).Offset(0, 2).Value
.Offset(0, 3).Value = Sheets(“Data”).Range(“A1”).Offset(0, 3).Value

End With

‘ 순환하면서 같은 데이터가 있으면 새로 만든 시트에 추가
For Each rngCell In rngTgt

If rngR = rngCell Then

cnt = cnt + 1

With Range(“A1”)
.Offset(cnt, 0).Value = rngCell.Offset(0, -1).Value
.Offset(cnt, 1).Value = rngCell.Offset(0, 0).Value
.Offset(cnt, 2).Value = rngCell.Offset(0, 1).Value
.Offset(cnt, 3).Value = rngCell.Offset(0, 2).Value
End With

End If

Next rngCell

cnt = 0
Columns.AutoFit

Next rngR

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

분리해야할 참조 영역이 정해져 있지 않아 특정 데이터 영역에서 추출해야하는 경우에는 아래의
팁을 응용하여 분리할 참조 영역을 중복되지않게 추출하고 그 추출된 데이터를 이용하여 두 영역을
비교하여 필요한 작업을 하시면 추출 관련해서는 이 두 팁을 이용하면 못할 것이 없을 것입니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=286263
(엑셀(EXCEL) – 임의 영역 중복항목 제거 루틴을 응용한 다대다(多對多) 항목 역전개(기준항목
변경))

첨부 화일 :  20151002-두 영역 비교하여 같은 값 추출 및 시트별로 분리 

By vinipapa • 무른모 • 0 • Tags: 시트 분리, 엑셀, 영역비교 추출, 팁

«< 26 27 28 29 30 >»

카테고리

  • 매킨토시 (261)
    • 굳은모 (73)
    • 무른모 (194)
  • 빈이네 (304)
    • 가족들 (108)
    • 까만콩 (60)
    • 엄마아빠 (131)
  • 잡동사니 (175)
    • 수다떨기 (37)
    • 정 보 (127)
    • 책읽기 (11)

그 밖의 기능

  • 로그인
  • 글 RSS
  • 댓글 RSS
  • WordPress.org

태그

AirPlay AirPrint Apple BootCamp bundle Database Design Dock Dropbox Edit Event Excel free iPad iPhone iTunes Limitted Free Mac Macbook Mac Bundle MacJournal Mac OSX Macupdate MobileMe OCR Pebble safari Sale share Snow Leopard software Tip tweet Twitter Update Windows 구입 나들이 맥 무료 빈이 업데이트 엑셀 엑셀(EXCEL) 팁
  • 29년 11개월 회사를 그만 두면서…
  • 2024 윤석열 탄핵 집회 참석
  • 맥 마이그레이션 중…
  • 동백
  • 같은 나무에 다른 색 잎 들

↑

© ::: 까만콩 빈이네 ::: 2026
Powered by WordPress • Themify WordPress Themes