무성의한 블로그

프로그램 목록을 비교하는 매크로입니다. 

제대로 된 설명이 없어서 소스코드를 보면서 이해하긴 힘듭니다. 

초기 소스라 정제되어 있지 않습니다. 

그렇지만 정제되어 있지 않기에 매크로 공부하기에는 좋지 않을까요? 

엑셀의 도움말을 활용하였으며 일부 소스는 인터넷에 공개된 내용을 참조했습니다. 

Sub save_Sheet()

    Dim i As Integer

    Dim j As Integer

    Dim targetCount  As Integer

    Dim rowCount As Integer

    Dim chkValue As String

    Dim targetValue As String

    '데이터 정리

    Range(Cells(12, 16), Cells(1000, 18)).Select

    Selection.ClearContents

    '처리전에 정렬하고 작업 들어감

    sortTables

    rowCount = Cells(10, 7)

    targetCount = Cells(10, 29)

    testCount = Cells(10, 53)

    i = 12

    j = 12

    '먼저 i를 하나씩 돌면서 처리함.

    '개발여부 체크

    Cells(2, 9) = Time

    Do While i < rowCount + 12

        chkValue = Cells(i, 7)

        Cells(2, 10) = i

        Do While j < targetCount + 12

            Cells(2, 11) = j

            targetValue = Cells(j, 28)

            '파일ID이 같으면

            If targetValue = chkValue Then

                '화면

                SetValue = Cells(j, 43)

                Cells(i, 16) = SetValue

                '구현여부

                SetValue = Cells(i, 44)

                If SetValue = "개발없음" Then

                    Cells(i, 4) = SetValue

                End If

                '구현

                SetValue = Cells(j, 45)

                Cells(i, 17).Select

                Cells(i, 17) = SetValue

                '파일비교 대상을 벗어나면

            ElseIf targetValue > chkValue Then

                Exit Do

            End If

            j = j + 1

        Loop

        i = i + 1

    Loop

''''''''''''''''''''''''''''''''''''

    i = 12

    j = 12

    Cells(4, 9) = Time

    '먼저 i를 하나씩 돌면서 처리함.

    Do While i < rowCount + 12

        chkValue = Cells(i, 7)

        Cells(4, 7) = i

        Cells(5, 7) = j

       ' Cells(2, 18) = i

        Do While j < testCount + 12

            targetValue = Cells(j, 53)

            testResult = Cells(j, 59)

            If targetValue = chkValue Then

                If testResult = "PASS" Then

                    SetValue = Cells(j, 60)

                    Cells(i, 18) = SetValue

                Else

                    Cells(i, 18) = "FAIL"

                End If

            ElseIf targetValue > chkValue Then

                Exit Do

            End If

            j = j + 1

        Loop

        '비교 끝나면 종료

        If j >= testCount + 12 Then

            Exit Do

        End If

        i = i + 1

    Loop

    Range("r12:r1000").Select

    Selection.Replace What:=".", Replacement:="-", LookAt:=xlPart, _

    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

    ReplaceFormat:=False

    Range("a1:zz1000").Select

    With Selection.Font

        .Name = "맑은 고딕"

        .Size = 10

    End With

    drawLine

    saveHistory

End Sub

Sub sortTables()

'

' Macro1 Macro

'

'비교 데이터

    Range("a12:w1000").Select

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _

        "G12:G1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets(1).Sort

        .SetRange Range("A12:w1000")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

'사업자 제공 진척현황

    Range("z12:Aw1000").Select

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _

        "ab12:ab1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets(1).Sort

        .SetRange Range("z12:Aw1000")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

'단위테스트 결과

    Range("ay12:bi1000").Select

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear

    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _

        "ba12:ba1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets(1).Sort

        .SetRange Range("ay12:bi1000")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    Cells(3, 16).Select

End Sub

Sub saveHistory()

'

' Macro1 Macro

'

    ' 시트를 새로 만든다.

    orgBookName = ActiveWorkbook.Name

    '먼저 기존 파일 존재 여부 체크함.

    dFile = "C:\Users\Standard\Desktop\감리 통합폴더\MACRO\추이분석\"

    fFile = "추이분석-" & Year(Date) & Month(Date) & ".xlsx"

    newFileName = dFile & fFile

    Set fs = CreateObject("Scripting.FileSystemObject")

    fileChkTF = fs.fileexists(newFileName)

    '만약 파일이 있으면 기존 파일에 시트를 추가하고 시트명을 부여함.

    If fileChkTF = True Then

        Workbooks.Open newFileName

        Sheets.Add before:=Sheets(1)

        Sheets(1).Name = "추이분석-" & Date & Hour(Time) & Minute(Time) & Second(Time)

    ' 만약 파일이 ㅓㅄ으면 새로 파일을 만들어 시트명을 변경함.

    Else

        Workbooks.Add

        ActiveWorkbook.SaveAs Filename:=newFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

        Sheets(1).Name = "추이분석-" & Date & Hour(Time) & Minute(Time) & Second(Time)

    End If

    '복사하기

    Workbooks(orgBookName).Activate

    Sheets(1).Select

    Range("A1:zz1000").Select

    Selection.Copy

    Workbooks(fFile).Activate

    Sheets(1).Select

    Range("A1").Select

    Sheets(1).Paste

    Workbooks(orgBookName).Activate

    Sheets(1).Cells(1, 1).Select

    Cells(1, 1) = Now()

    Application.CutCopyMode = False

    ActiveWorkbook.Save

End Sub

Sub Macro2()

'

' Macro2 Macro

'

'

    Range("L9:P23").Select

    With Selection.Font

        .Name = "굴림"

        .Size = 9

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

End Sub

Sub drawLine()

'

' Macro3 Macro

    pgmCnt = Cells(10, 7).Value

    Range(Cells(12, 1), Cells(pgmCnt + 12, 23)).Select

'    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

'    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    '가는선 긋기

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    '굵은선 긋기

    Range(Cells(12, 16), Cells(pgmCnt + 12, 19)).Select

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlMedium

    End With

End Sub

Sub getFileInfo()

    '파일명만 가져옴.

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    Dim vrtSelectedItem As Variant

    '기존 정보 제거

    Range(Cells(5, 11), Cells(5, 13)).Select

    Selection.Clear

    idxItems = 1

    With fd

        .InitialFileName = "C:\Users\Standard\Desktop\감리 통합폴더\MACRO\"

        .AllowMultiSelect = True

'        .AllowMultiSelect = False

        If .Show = -1 Then

            '파일폴더만 가져옴

            myFolderName = .InitialFileName

            nameLenth = Len(myFolderName)

            Cells(5, idxItems + 11).Value = myFolderName

            For Each vrtSelectedItem In .SelectedItems

                '폴더+파일명 가져옴

                fileFullName = vrtSelectedItem

                '파일명을 자름

                myFileName = Mid(fileFullName, nameLenth + 1)

                Cells(5, idxItems + 12) = myFileName

                idxItems = idxItems + 1

            Next vrtSelectedItem

        'The user pressed Cancel.

        Else

        End If

    End With

    'Set the object variable to Nothing.

    Set fd = Nothing

    fstFile = Cells(5, 13)

    scdFile = Cells(5, 14)

    If Mid(fstFile, 1, 4) = "PMO_" Then

        Cells(5, 13) = scdFile

        Cells(5, 14) = fstFile

    End If

End Sub

Sub getRawData()

    ' 파일중 작업할 내용을 복사해 옴

    ' 시작한 화면.

    orgBookName = ActiveWorkbook.Name

    '데이터 정리

    Range(Cells(11, 26), Cells(1000, 65)).Select

    Selection.Clear

    ' 파일열기

    d_name = Sheets(1).Cells(5, 12).Value

    '첫번째

    f_name1 = Sheets(1).Cells(5, 13).Value

    '두번째

    f_name2 = Sheets(1).Cells(5, 14).Value

    If Mid(f_name1, 1, 3) = "PMO" Then

        f_name3 = f_name1

        f_name1 = f_name2

        f_name2 = f_name3

    End If

    file_name1 = d_name & f_name1

    file_name2 = d_name & f_name2

    Dim fs, f, s

    Set fs = CreateObject("Scripting.FileSystemObject")

    ' 첫번재 파일 처리

    ' 프로그램 목록 가져오기

    Set f = fs.GetFile(file_name1)

    Workbooks.Open Filename:=file_name1

    Workbooks(f_name1).Activate

    Selection.AutoFilter

    Sheets(2).Select

    Range(Cells(4, 3), Cells(1000, 26)).Select

    Selection.Copy

    Workbooks(orgBookName).Activate

    Cells(11, 26).Select

    ActiveSheet.Paste

    '파일 닫기

    Application.DisplayAlerts = False

    Workbooks(f_name1).Close SaveChanges:=False

    ' 두번째 파일 처리

    ' 단위테스트 결과 가져오기

    Set f = fs.GetFile(file_name2)

    Workbooks.Open Filename:=file_name2

    Selection.AutoFilter

    ' 두번째 파일

    ' 첫번째 시트 처리

    shtPnt = 5

    shtCnt = ActiveWorkbook.Sheets.Count

    Do While shtPnt < shtCnt + 1

        '테스트 결과 복사해오기

        Workbooks(f_name2).Activate

        Sheets(shtPnt).Select

        If shtPnt = 5 Then

            Range(Cells(2, 1), Cells(1000, 11)).Select

        Else

            Range(Cells(3, 1), Cells(1000, 11)).Select

        End If

        Selection.Copy

        '추이분석 시트에 옮겨적기

        Workbooks(orgBookName).Activate

        Sheets(1).Select

        startPoint = Cells(10, 53)

        If shtPnt = 5 Then

            Cells(11, 51).Select

        Else

            Cells(startPoint + 12, 51).Select

        End If

        ActiveSheet.Paste

        shtPnt = shtPnt + 1

    Loop

    '파일 닫기

    Application.DisplayAlerts = False

    Workbooks(f_name2).Close SaveChanges:=False

End Sub

Sub addListCount()

'오른쪽 리스트를 최신이라 생각하고 왼쪽에 업데이트 한다.

' 1. 왼쪽에 있으나 오른쪽에 없는 것은 삭제된 리스트다.

    '비교를 위해 정렬

    sortTables

    rowCount = Cells(10, 7)

    targetCount = Cells(10, 29)

    pasteCount = Cells(10, 77)

    i = 12

    j = 12

    addedList = 0

    removedList = 0

    '먼저 i를 하나씩 돌면서 처리함.

    '개발여부 체크

    Do While i < rowCount + 12

        chkValue = Cells(i, 7)

        Do While j < targetCount + 12

            targetValue = Cells(j, 28)

            '파일ID이 같으면

            If targetValue = chkValue Then

                '다음 값으로 넘어간다

                existFlag = "Y"

                j = j + 1

                i = i + 1

                Exit Do

            '같은 값을 찾지 못하면

            ' 2. 추가된 리스트는 확인한다.

            ElseIf targetValue < chkValue Then

                existFlag = "F"

                j = j + 1

                addedList = addedList + 1

                Exit Do

            ' 2. 삭제된 리스트는 삭제 항목으로 이동한다.

            ElseIf targetValue > chkValue Then

                existFlag = "F"

                i = i + 1

                removedList = removedList + 1

                Exit Do

             End If

        Loop

    Loop

' 3. 왼쪽 리스트를 복사하여 새 리스트로 업데이트 한다.

    Cells(3, 8) = addedList

    Cells(4, 8) = removedList

    listChangeYN = 0

    If addedList > 0 Then

        listChangeYN = MsgBox("불일치한 파일이 있습니다. 리스트를 변경할까요?", vbOKCancel, "확인")

    ElseIf removedList > 0 Then

        listChangeYN = MsgBox("불일치한 파일이 있습니다. 리스트를 변경할까요?", vbOKCancel, "확인")

    Else

        listChangeYN = MsgBox("불일치한 파일이 없습니다. ", vbOKOnly, "확인")

        listChangeYN = 0

    End If

    If listChangeYN = 1 Then

        newListSet

    End If

    Cells(1, 1).Activate

End Sub

Sub newListSet()

'오른쪽 리스트를 최신이라 생각하고 왼쪽에 업데이트 한다.

' 1. 왼쪽에 있으나 오른쪽에 없는 것은 삭제된 리스트다.

    '비교를 위해 정렬

    sortTables

    rowCount = Cells(10, 7)

    targetCount = Cells(10, 29)

    pasteCount = Cells(10, 77)

    i = 12

    j = 12

    addedList = 0

    '먼저 i를 하나씩 돌면서 처리함.

    Do While i < rowCount + 12

    chkValue = Cells(i, 7)

        Do While j < targetCount + 12

            targetValue = Cells(j, 28)

            '파일ID이 같으면

            If targetValue = chkValue Then

                '다음 값으로 넘어간다

                existFlag = "Y"

                j = j + 1

                i = i + 1

                Exit Do

            '같은 값을 찾지 못하면

            ' 2. 추가된 리스트는 확인한다.

            ElseIf targetValue < chkValue Then

                existFlag = "F"

                j = j + 1

                addedList = addedList + 1

                Exit Do

            ' 2. 삭제된 리스트는 삭제 항목으로 이동한다.

            ElseIf targetValue > chkValue Then

                pasteCount = Cells(10, 77)

                existFlag = "F"

                i = i + 1

                removedList = removedList + 1

                Range(Cells(i, 1), Cells(i, 23)).Copy

                Cells(pasteCount + 12, 71).Select

                ActiveSheet.Paste

                Exit Do

             End If

        Loop

        If i >= rowCount + 12 Then

            Exit Do

        End If

    Loop

' 3. 왼쪽 리스트를 복사하여 새 리스트로 업데이트 한다.

    Range(Cells(12, 5), Cells(1000, 11)).ClearContents

    Range(Cells(12, 26), Cells(1000, 32)).Select

    Selection.Copy

    Cells(12, 5).Select

    ActiveSheet.Paste

End Sub

Sub backup()

''''''''''''''''''''''''''''''''''''''''''''''''''''''

    i = 12

    j = 12

    '먼저 i를 하나씩 돌면서 처리함.

    '개발여부 체크

    Cells(3, 9) = Time

    Do While i < rowCount + 12

        chkValue = Cells(i, 7)

        Cells(3, 10) = i

        Cells(3, 11) = j

        Do While j < targetCount + 12

            targetValue = Cells(j, 28)

            '파일ID이 같으면

            If targetValue = chkValue Then

 '               SetValue = Cells(j, 43)

 '               Cells(i, 16) = SetValue

                SetValue = Cells(i, 44)

                If SetValue = "개발없음" Then

                    Cells(i, 4) = SetValue

                End If

 '               SetValue = Cells(j, 45)

 '               Cells(i, 17) = SetValue

            '파일비교 대상을 벗어나면

            ElseIf targetValue > chkValue Then

                Exit Do

            End If

            j = j + 1

        Loop

        i = i + 1

    Loop

''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''

    i = 12

    j = 12

    '먼저 i를 하나씩 돌면서 처리함.

    '개발여부 체크

    Cells(4, 9) = Time

    Do While i < rowCount + 12

        chkValue = Cells(i, 7)

        Cells(4, 10) = i

        Cells(4, 11) = j

        Do While j < targetCount + 12

            targetValue = Cells(j, 28)

            '파일ID이 같으면

            If targetValue = chkValue Then

 '               SetValue = Cells(j, 43)

 '               Cells(i, 16) = SetValue

'                SetValue = Cells(i, 44)

'                If SetValue = "개발없음" Then

'                    Cells(i, 4) = SetValue

'                End If

                SetValue = Cells(j, 45)

                Cells(i, 17) = SetValue

            '파일비교 대상을 벗어나면

            ElseIf targetValue > chkValue Then

                Exit Do

            End If

            j = j + 1

        Loop

        i = i + 1

    Loop

''''''''''''''''''''''''''''''''''''

End Sub

엑셀의 여러 파일을 열어 단어를 추출하는 매크로입니다. 

Option Compare Text

Sub StartMacro()

'박규효 2011년 03월 22일 제작

End Sub

Sub getFolder()

    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    ' 현재 있는 데이터를 모두 삭제해야 함.

    Sheets("fileSheet").Activate

    ActiveSheet.Range("d3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

    '서브폴더의 내용을 가져옴

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("d3") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("d3").Value

            SearchSubFolders2

        End If

    End With

End Sub

Sub extractWord()

'

    '변수 선언 integer 는 32767 까지의 값만을 지원한다.

    Dim i As Integer

    Dim maxVal As Integer

    Dim startVal As Integer

    Dim nextVal As Integer

    Dim fileCnt As Integer           ' 파일의 수

    Dim sheetCnt As Integer     ' 파일의 시트 수

    Dim sNo As Integer          ' 처리한 시트 수

    Dim cellPnt As Integer

    Dim rowCnt As Integer

    Dim colCnt As Integer

    Dim f_name As String        '읽고자 하는 파일명

    Dim t_name As String        '매핑정의서에 기재된 소스테이블명

    Dim file_name As String      '파일명 전체

    Dim targetWord As String   '찾고자하는 단어명

    Dim cellVal As String       '단어를 찾은 셀의 내용

    '변수 기본값 할당

    i = 9           ' 첫 파일명이 세번째 줄에 있음.

    cellPnt = 2     ' 두번째 줄부터 써야 함.

    maxVal = 0      '   초기화

    startVal = 1    ' 파일 찾기 시작

    nextVal = 0     '   초기화

    '처리할 파일의 갯수

    fileCnt = Sheets("fileSheet").Cells(8, 5).Value

    targetWord = Sheets("fileSheet").Cells(1, 2).Value

    srVal = Sheets("fileSheet").Cells(1, 4).Value

    scVal = Sheets("fileSheet").Cells(1, 6).Value

    erVal = Sheets("fileSheet").Cells(1, 9).Value

    ecVal = Sheets("fileSheet").Cells(1, 11).Value

    ' 현재 있는 데이터를 모두 삭제해야 함.

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = "단어추출-" & Date & Hour(Time) & Minute(Time) & Second(Time)

    Sheets(2).Activate

    Cells(1, 1).Value = "번호"

    Cells(1, 2).Value = "폴더명"

    Columns("b:b").ColumnWidth = 20

'    Rows("8:8").RowHeight = 35.25

    Cells(1, 3).Value = "파일명"

    Columns("c:c").ColumnWidth = 40

    Cells(1, 4).Value = "시트명"

    Columns("d:d").ColumnWidth = 20

    Cells(1, 5).Value = "셀위치"

    Cells(1, 6).Value = "조회결과"

    Columns("f:f").ColumnWidth = 20

    Range(Cells(1, 1), Cells(1, 7)).Select

    Selection.AutoFilter

    '반복하며 파일 처리 함

    Do While i < fileCnt + 9

        sNo = 1

'        ' 파일열기

        d_name = Sheets("fileSheet").Cells(i, 2).Value

        f_name = Sheets("fileSheet").Cells(i, 3).Value

        file_name = d_name + "\" + f_name

        Dim fs, f, s

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFile(file_name)

            Workbooks.Open Filename:=file_name

            sheetCnt = ActiveWorkbook.Sheets.Count

    '        '시트 수 만큼 반복하며 확인할 것

            Do While sNo <= sheetCnt

                Workbooks(f_name).Activate

                If Sheets(sNo).Visible = False Then

                Else

                    Sheets(sNo).Select

                    sName = Sheets(sNo).Name

                    With Worksheets(sNo).Range(Cells(srVal, scVal), Cells(erVal, ecVal))

                        Set c = .Find(targetWord, LookIn:=xlValues)

                        If Not c Is Nothing Then

                            firstAddress = c.Address

                            Do

                                cellVal = c.Value

                                '확인된 시트명을 결과시트에 적기

                                Workbooks("감리자동화도구-단어추출.xls").Activate

                                Sheets(2).Activate

                                ActiveSheet.Cells(cellPnt, 2).Select

                                ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)

                                ActiveSheet.Cells(cellPnt, 2).Value = d_name

                                ActiveSheet.Cells(cellPnt, 3).Value = f_name

                                ActiveSheet.Cells(cellPnt, 4).Value = sName

                                anchorinfo = file_name + "#" + sName + "!" + c.Address

                                ActiveSheet.Hyperlinks.Add anchor:=Cells(cellPnt, 5), Address:=anchorinfo, TextToDisplay:=c.Address

                                ActiveSheet.Cells(cellPnt, 6).Value = cellVal

                                cellPnt = cellPnt + 1

                                Set c = .FindNext(c)

                                If c Is Nothing Then

                                    Exit Do

                                End If

                            Loop While Not c Is Nothing And c.Address <> firstAddress

                        Else

                            '확인된 시트명을 결과시트에 적기

                            Workbooks("감리자동화도구-단어추출.xls").Activate

                            Sheets(2).Activate

    '                        ActiveSheet.Cells(cellPnt, 2).Select

                            ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)

                            ActiveSheet.Cells(cellPnt, 2).Value = d_name

                            ActiveSheet.Cells(cellPnt, 3).Value = f_name

                            ActiveSheet.Cells(cellPnt, 4).Value = sName

                            ActiveSheet.Cells(cellPnt, 5).Value = "없음"

                            ActiveSheet.Cells(cellPnt, 6).Value = "없음"

                            cellPnt = cellPnt + 1

                        End If

                    End With

                End If

                Cells(cellPnt, 1).Select

                sNo = sNo + 1

            Loop

            '파일 닫기

            Application.DisplayAlerts = False

            Workbooks(f_name).Close SaveChanges:=False

         i = i + 1

    Loop

    Range("a1:k1000").Select

    With Selection.Font

        .Name = "맑은 고딕"

        .Size = 10

    End With

    MsgBox ("작업을 완료하였습니다.")

End Sub

Sub SearchSubFolders2()

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    strDir = Range("d3").Value

    If strDir = "" Then

        MsgBox ("선택된 폴더가 없습니다. 폴더를 선택하세요.")

        Exit Sub

    End If

    r = 8

    Sheets(1).Cells(r, 2) = "폴더명"

    Sheets(1).Cells(r, 3) = "파일명"

    Sheets(2).Range("a1:d1").Font.Name = "Arial"

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    strFilter = Range("d4").Value

    result = sRetrieve(strDir, strFilter, r)

End Sub

Private Function sRetrieve(sPath As String, strFilter As String, r As LoadPictureConstants) As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    For Each dDir In dDirs.SubFolders

        sRetrieve = sRetrieve(dDir.Path, strFilter, r) ' Here is the recursion

    Next

    For Each fFile In dDirs.Files

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path

            Sheets(1).Cells(r, 3) = fFile.Name

            r = r + 1

        End If

    Next

    Set fs = Nothing

End Function

마이크로소프트 Wedge Touch Mouse

일반적으로 사용하는 무선마우스는 마우스와 usb 형태의 리시버로 구성되어 있습니다.

마우스에서 보내는 신호를 리시버에서 수신하여 노트북에 전달하는 구조이지요. 보통은 2.4GH 주파수를 사용하고 요즘은 5GH도 많이 출시되고 있습니다.

블루투스 마우스는 노트북의 블루투스 기능을 사용하여 통신하기 때문에 별도의 리시버가 필요없는 마우스 입니다

보통 무선마우스나 무선키보드는 리시버와 1:1로 종속되어 있습니다.

그래서 만약 리시버를 잃어버린다면 본체도 교환해야 합니다. A/S를 통해 리시버만 다시 받거나교체 할 수는 없습니다.

그러나 블루투스 마우스는 리시버가 없기 때문에 잃어버릴 위험도 없습니다.

최근에 마이크로소프트에서 출시한 Wedge Touch Mouse를 선물 받았습니다.

제품 출시는 2012년 8월 정도인데, 주변 사람들 중에 이 제품을 사용하는 분은 아직 못 봤습니다.

가격도 좀 비싼 편입니다. 인터넷 상점에서 대략 5만원 전후로 판매되는데, 마우스 하나 값으로는 좀 센 편이죠.

실제 사용해보니 마우스 포인트의 움직임은 좋습니다. 부드럽게 움직이네요.

그리고 왼쪽 오른쪽 클릭도 부드러운 편이구요.

검은색의 무광 마우스이며 매끈하지 않고 부드러운 느낌의 표면은 사용할 때 손가락에 편안한 느낌을 줍니다.  

사진에 보는 것처럼 마우스의 크기는 무척 작습니다. 비교된 치실의 크기를 보면 감이 오실 겁니다.

작은 만큼 처음 사용할 때는 무척이나 낯설게 느껴집니다.

보통 마우스를 사용할 때 손바닥을 마우스에 올린 상태에서 손가락으로 사용하는데 비해 이 제품은 손바닥을 얹을 부분이 없습니다.

마우스 앞의 버튼 부분만 칼로 몽창 짤라서 만든 것같이 생겼으니까요.

그래도 며칠 동안 계속 사용하니 손가락에 적응이 되네요.

터치감은 상당히 좋습니다. 특히 하루 종일 마우스를 잡고 있는 직업 상 좌우 버튼 클릭 시 딸깍거리는 거 조차 신경쓰였는데 이 제품은 그런 면에서 좋네요.

하단의 빛은 파란색입니다. 보통 빨간색이지요.

불편한 점은. 가운데 휠인데, 휠이 터치방식이라 민감하게 다루기가 불편합니다.

가운데 있는 은색선을 따라 손가락을 움직이면 상하 스크롤이 되는데 아무래도 하드웨어 휠보다

터치하기가 쉽지 않습니다.

그리고 마우스를 사용하는 동안 마우스 위에 손가락을 올려 놓으면 자연스럽게 휠에도 손가락이 닿게 됩니다. 이 때 갑자기 화면이 상하로 스크롤 되어 버리는 경우가 있습니다.

그리고 블루투스를 사용하기에 초기 활성화가 늦은 편입니다.  

노트북의 블루투스 서비스가 활성화된 후에 마우스를 사용할 수 있기에 리시버를 사용하는 제품에 비해 초기 활성화가 늦습니다.

Sub getFolder()

    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    ' 현재 있는 데이터를 모두 삭제해야 함.

    Sheets("fileSheet").Activate

    ActiveSheet.Range("d3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

   
    Cells(1, 1) = "단어:"
    Cells(1, 3) = "을"
    Cells(1, 5) = "행"
    Cells(1, 7) = "열부터"
    Cells(1, 10) = "행"
    Cells(1, 12) = "열까지에서 찾기"
   
   
    Range("B1,D1,F1,I1,K1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Cells(8, 5) = "*.xls*"

    '서브폴더의 내용을 가져옴

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("D8") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("D8").Value

            SearchSubFolders2

        End If

    End With

    Cells(8, 6) = "=counta(C9:C2000)"

End Sub

Sub extractWord()
'
   
    '변수 선언 integer 는 32767 까지의 값만을 지원한다.
    Dim i As Integer
    Dim maxVal As Integer
    Dim startVal As Integer
    Dim nextVal As Integer

    Dim fileCnt As Integer           ' 파일의 수
    Dim sheetCnt As Integer     ' 파일의 시트 수
    Dim sNo As Integer          ' 처리한 시트 수
    Dim cellPnt As Integer
    Dim rowCnt As Integer
    Dim colCnt As Integer
   
    Dim f_name As String        '읽고자 하는 파일명
    Dim t_name As String        '매핑정의서에 기재된 소스테이블명
    Dim file_name As String      '파일명 전체
    Dim targetWord As String   '찾고자하는 단어명
    Dim cellVal As String       '단어를 찾은 셀의 내용
   
    '변수 기본값 할당
    i = 9           ' 첫 파일명이 세번째 줄에 있음.
    cellPnt = 2     ' 두번째 줄부터 써야 함.
    maxVal = 0      '   초기화
    startVal = 1    ' 파일 찾기 시작
    nextVal = 0     '   초기화
   
    '처리할 파일의 갯수\
    orgWorkBookName = ActiveWorkbook.Name
   
    fileCnt = Cells(8, 6).Value
    targetWord = Sheets("fileSheet").Cells(1, 2).Value
    srVal = Sheets("fileSheet").Cells(1, 4).Value
    scVal = Sheets("fileSheet").Cells(1, 6).Value
    erVal = Sheets("fileSheet").Cells(1, 9).Value
    ecVal = Sheets("fileSheet").Cells(1, 11).Value
       
    ' 현재 있는 데이터를 모두 삭제해야 함.
   
    Sheets.Add after:=Sheets(1)
    Sheets(2).Name = "단어추출-" & Date & Hour(Time) & Minute(Time) & Second(Time)
   
    Sheets(2).Activate
    Cells(1, 1).Value = "번호"
    Cells(1, 2).Value = "폴더명"
    Columns("b:b").ColumnWidth = 20
'    Rows("8:8").RowHeight = 35.25
    Cells(1, 3).Value = "파일명"
    Columns("c:c").ColumnWidth = 40
    Cells(1, 4).Value = "시트명"
    Columns("d:d").ColumnWidth = 20
    Cells(1, 5).Value = "셀위치"
    Cells(1, 6).Value = "조회결과"
    Columns("f:f").ColumnWidth = 20
    Range(Cells(1, 1), Cells(1, 7)).Select
    Selection.AutoFilter
   
    '반복하며 파일 처리 함
    Do While i < fileCnt + 9

        sNo = 1

'        ' 파일열기
        d_name = Sheets("fileSheet").Cells(i, 2).Value
        f_name = Sheets("fileSheet").Cells(i, 3).Value
        file_name = d_name + "\" + f_name
   
        Dim fs, f, s
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFile(file_name)
       
            Workbooks.Open Filename:=file_name
           
           
            sheetCnt = ActiveWorkbook.Sheets.Count
           
   
    '        '시트 수 만큼 반복하며 확인할 것
           
            Do While sNo <= sheetCnt
              
                Workbooks(f_name).Activate
                If Sheets(sNo).Visible = False Then
                Else
                    Sheets(sNo).Select
                    sName = Sheets(sNo).Name
                   
                    With Worksheets(sNo).Range(Cells(srVal, scVal), Cells(erVal, ecVal))
                        Set c = .Find(targetWord, LookIn:=xlValues)
                        If Not c Is Nothing Then
                            firstAddress = c.Address
                            Do
                                cellVal = c.Value
                                '확인된 시트명을 결과시트에 적기
                                Workbooks(orgWorkBookName).Activate
                                Sheets(2).Activate
                                ActiveSheet.Cells(cellPnt, 2).Select
                                ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)
                                ActiveSheet.Cells(cellPnt, 2).Value = d_name
                                ActiveSheet.Cells(cellPnt, 3).Value = f_name
                                ActiveSheet.Cells(cellPnt, 4).Value = sName
                                anchorinfo = file_name + "#" + sName + "!" + c.Address
                               
                                ActiveSheet.Hyperlinks.Add anchor:=Cells(cellPnt, 5), Address:=anchorinfo, TextToDisplay:=c.Address
                               
                                ActiveSheet.Cells(cellPnt, 6).Value = cellVal
                               
                                cellPnt = cellPnt + 1
                               
                                Set c = .FindNext(c)
                                If c Is Nothing Then
                                    Exit Do
                                End If
                               
                            Loop While Not c Is Nothing And c.Address <> firstAddress
                      
                        Else
                            '확인된 시트명을 결과시트에 적기
                            Workbooks("감리자동화도구-단어추출.xls").Activate
                            Sheets(2).Activate
    '                        ActiveSheet.Cells(cellPnt, 2).Select
                            ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)
                            ActiveSheet.Cells(cellPnt, 2).Value = d_name
                            ActiveSheet.Cells(cellPnt, 3).Value = f_name
                            ActiveSheet.Cells(cellPnt, 4).Value = sName
                            ActiveSheet.Cells(cellPnt, 5).Value = "없음"
                            ActiveSheet.Cells(cellPnt, 6).Value = "없음"
                            cellPnt = cellPnt + 1
                        End If
                    End With
                End If
                Cells(cellPnt, 1).Select
                sNo = sNo + 1
            Loop
        
            '파일 닫기
            Application.DisplayAlerts = False
            Workbooks(f_name).Close SaveChanges:=False
           
         i = i + 1
           
    Loop
    Range("a1:k1000").Select
    With Selection.Font
        .Name = "맑은 고딕"
        .Size = 10
    End With
   
    MsgBox ("작업을 완료하였습니다.")
   
End Sub
 

Sub SearchSubFolders2()
    Dim result As String
    Dim strFilter As String
    Dim Msg As String
    Dim strDir As String
    Dim r As Long
   
    strDir = Range("D8").Value
    If strDir = "" Then
        MsgBox ("선택된 폴더가 없습니다. 폴더를 선택하세요.")
        Exit Sub
    End If
  
    r = 8
   
    Sheets(1).Cells(r, 2) = "폴더명"
    Sheets(1).Cells(r, 3) = "파일명"

    Sheets(2).Range("a1:d1").Font.Name = "Arial"

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"
 
    strFilter = Range("E8").Value
   
    result = sRetrieve(strDir, strFilter, r)
  
End Sub

Private Function sRetrieve(sPath As String, strFilter As String, r As LoadPictureConstants) As String
  
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dDirs = fs.getFolder(sPath)
  
    For Each dDir In dDirs.SubFolders
        sRetrieve = sRetrieve(dDir.Path, strFilter, r) ' Here is the recursion
    Next
  
    For Each fFile In dDirs.Files
        If fFile.Name Like "~*" Then
        ElseIf fFile.Name Like strFilter Then
            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path
            Sheets(1).Cells(r, 3) = fFile.Name
            r = r + 1
        End If
    Next
   
    Set fs = Nothing

End Function

Sub 매크로1()
'
' 매크로1 매크로
'

'

End Sub
Sub 매크로2()
'
' 매크로2 매크로
'

'

End Sub

Sub getFolder()

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("c3").Select

    Selection.ClearContents

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"

    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    ' 현재 있는 데이터를 모두 삭제해야 함.

    Sheets("fileSheet").Activate

    ActiveSheet.Range("c3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

    '서브폴더의 내용을 가져옴

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("c3") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("c3").Value

        End If

    End With

End Sub

Sub getSubFolderInHere()

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

    ActiveSheet.Range("b9:f10000").Value = ""

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

    r = 9

    Sheets(1).Cells(7, 1) = "검색폴더"

    Sheets(1).Cells(7, 2) = strDir

    Sheets(1).Cells(8, 1) = "검색단어"

    Sheets(1).Cells(8, 2) = strFileType

    Sheets(1).Cells(r, 1) = "번호"

    Sheets(1).Cells(r, 2) = "하위 폴더명"

    Sheets(1).Cells(r, 2).ColumnWidth = 45

    Sheets(1).Cells(r, 3) = "파일명"

    Sheets(1).Cells(r, 3).ColumnWidth = 45

    Sheets(1).Cells(r, 4) = "크기"

    Sheets(1).Cells(r, 5) = "파일타입"

    Sheets(1).Cells(r, 6) = "작성일"

    Sheets(1).Cells(r, 7) = "수정일"

    Sheets(1).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    Cells(10, 2).Select

    ActiveWindow.FreezePanes = True

    Sheets(1).Range("a10", "g1000").Select

    Selection.ClearContents

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    result = sRetrieveInHere(strDir, strFilter, r)

    Sheets(1).Range("a1:g1000").Font.Name = "Arial"

    Sheets(1).Range("a1:g1000").Font.Size = 9

    Sheets(1).Range(Cells(4, 2), Cells(r, 2)).Select

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

    Selection.Font.Underline = xlUnderlineStyleNone

    Sheets(1).Cells(4, 2).Select

End Sub

Sub getSubFolderInNext()

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

    ActiveSheet.Range("b9:f10000").Value = ""

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

    r = 3

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = Date & Hour(Time) & Minute(Time) & Second(Time)

    Sheets(2).Cells(7, 1) = "검색폴더"

    Sheets(2).Cells(7, 2) = strDir

    Sheets(2).Cells(8, 1) = "검색단어"

    Sheets(2).Cells(8, 2) = strFileType

    Sheets(2).Cells(r, 1) = "번호"

    Sheets(2).Cells(r, 2) = "하위 폴더명"

    Sheets(2).Cells(r, 2).ColumnWidth = 45

    Sheets(2).Cells(r, 3) = "파일명"

    Sheets(2).Cells(r, 3).ColumnWidth = 45

    Sheets(2).Cells(r, 4) = "크기"

    Sheets(2).Cells(r, 5) = "파일타입"

    Sheets(2).Cells(r, 6) = "작성일"

    Sheets(2).Cells(r, 7) = "수정일"

    Sheets(2).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    Cells(4, 2).Select

    ActiveWindow.FreezePanes = True

    Sheets(2).Range("a4", "g1000").Select

    Selection.ClearContents

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    result = sRetrieveInNext(strDir, strFilter, r)

    Sheets(2).Range("a1:g1000").Font.Name = "Arial"

    Sheets(2).Range("a1:g1000").Font.Size = 9

    Sheets(2).Range(Cells(4, 2), Cells(r, 2)).Select

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

    Sheets(2).Cells(4, 2).Select

End Sub

Private Function sRetrieveInNext(sPath As String, strFilter As String, r As Long) As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    For Each dDir In dDirs.SubFolders

        sRetrieveInNext = sRetrieveInNext(dDir.Path, strFilter, r)

    Next

    For Each fFile In dDirs.Files

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            Sheets(2).Cells(r, 1) = r - 3

            Sheets(2).Cells(r, 2) = fFile.parentfolder.Path

            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            Sheets(2).Cells(r, 4) = fFile.Size

            Sheets(2).Cells(r, 5) = fFile.Type

            Sheets(2).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(2).Cells(r, 7) = Left(fFile.DateLastModified, 10)

           r = r + 1

        End If

    Next

    Set fs = Nothing

End Function

Private Function sRetrieveInHere(sPath As String, strFilter As String, r As Long) As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    For Each dDir In dDirs.SubFolders

        sRetrieveInHere = sRetrieveInHere(dDir.Path, strFilter, r)

    Next

    For Each fFile In dDirs.Files

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            Sheets(1).Cells(r, 1) = r - 9

            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path

            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            Sheets(1).Cells(r, 4) = fFile.Size

            Sheets(1).Cells(r, 5) = fFile.Type

            Sheets(1).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(1).Cells(r, 7) = Left(fFile.DateLastModified, 10)

           r = r + 1

        End If

    Next

    Set fs = Nothing

End Function

문서를 실행하시면 컨텐츠 사용여부를 묻는 메세지가 나옵니다.
반드시 허용하셔야 합니다.

1. 폴더 가져오기로 해당 폴더의 워드파일들을 가져옵니다.
너무 많으면 오류가 발생할 수 있으므로 적당한 수로 나누어서 하시기 바랍니다.
한 50개 정도는 문제가 없었던거 같습니다.

2. 문서 중에 검색 대상이 아닌 문서는 목록에서 선택하신 후 리스트 1건 삭제 버튼을 클릭하시면 됩니다.

3. 검색단어 에 검색할 단어를 입력하시고 하단의 자료추출 버튼을 클릭하시면됩니다.

4. 검색조건은 몇개의 파일을 하나의 결과문서에 나타낼지를 정하는 것입니다.
예를 들어 50개 문서에 검색조건 10을 선택하면 결과문서는 5개가 나옵니다.

오류가 발생하는 경우가 있습니다. 이 때는 매크로 창에서 도구->참조 창을 엽니다.
사용가능한 참조 들 중에 앞에 '누락-'으로 시작하는 항목들이 있는데 이 것들의 체크박스를 풀어주시면 정상적으로 수행될 것입니다.

한번 써보시면 쉽게 될 겁니다. 

--------------------------------------------

문서 검색.docm

Private Sub CommandButton1_Click()

getFolder

End Sub

Private Sub CommandButton2_Click()

    getSentense

End Sub

Sub goCopy()

    varCnt = ListBox1.ListCount

    fileCnt = TextBox2.Value

    i = 0

    Do While i < varCnt

        fileNum = i Mod fileCnt

        If fileNum = 0 Then

            If i = 0 Then

            Else

                ActiveDocument.Close SaveChanges:=wdSaveChanges

            End If

            ChangeFileOpenDirectory TextBox1.Text

            Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0

            newFileName = "복사대상" & i + 1 & "-" & i + fileCnt & Date & Hour(Time) & Minute(Time) & Second(Time) & ".docx"

            ActiveDocument.SaveAs FileName:=newFileName

        End If

        fileVal = ListBox1.List(i)

        chkLen = InStr(fileVal, "-")

        fileVal = Left(fileVal, chkLen - 1)

        '복사할 대상을 열어 복사함

        Documents.Open FileName:=fileVal, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

        Selection.WholeStory

        Selection.Copy

        Documents(fileVal).Close

        '새 파일을 저장한 위치로 옮김.

        ChangeFileOpenDirectory TextBox1.Text

        Documents(newFileName).Activate

        Documents(newFileName).Select

        '새파일의 맨 뒤로 이동함.

        Selection.EndKey Unit:=wdStory

        '붙혀넣기 전에 링크를 추가함

        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _

            fileVal, SubAddress:="", ScreenTip:="", TextToDisplay:=fileVal

        '붙여 넣기함.

        Selection.PasteAndFormat (wdPasteDefault)

        ' 맨 뒤로 이동하여 다음 파일 붙여넣기 준비함

        Selection.EndKey Unit:=wdStory

        '다음 페이지로 넘어가기 ctr+enter

        Selection.InsertBreak Type:=wdPageBreak

        i = i + 1

    Loop

    ActiveDocument.Save

End Sub

Sub getFolder()

    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    ' 현재 있는 데이터를 모두 삭제해야 함.

    ListBox1.Clear

    '서브폴더의 내용을 가져옴

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            folderspec = .SelectedItems(1)  '선택한 폴더명을 A3 셀에 저장

            getSubFolder (folderspec)

        End If

    End With

    TextBox1.Text = folderspec

    TextBox11.Text = ListBox1.ListCount

    TextBox2.Text = ListBox1.ListCount

End Sub

Sub getSubFolder(folderspec)

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    strDir = folderspec

    If strDir = "" Then

        MsgBox (" 선택된 폴더가 없습니다. 폴더를 선택하세요.")

        Exit Sub

    End If

    r = 1

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    strFilter = "*.doc*"

    result = sRetrieve(strDir, strFilter, r)

End Sub

Private Function sRetrieve(sPath As String, strFilter As String, r As Long) As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    For Each dDir In dDirs.SubFolders

        sRetrieve = sRetrieve(dDir.Path, strFilter, r)

    Next

    For Each fFile In dDirs.Files

        If fFile.Name Like strFilter Then

            If Left(fFile.Name, 1) = "~" Then

            Else

                ListBox1.AddItem fFile.Path & "-" & fFile.Size

            End If

            r = r + 1

        End If

    Next

    Set fs = Nothing

End Function

Private Sub CommandButton3_Click()

    'Ensure ListBox contains list items

    If ListBox1.ListCount >= 1 Then

        'If no selection, choose last list item.

        If ListBox1.ListIndex = -1 Then

            ListBox1.ListIndex = ListBox1.ListCount - 1

        End If

        ListBox1.RemoveItem (ListBox1.ListIndex)

    End If

    TextBox11 = ListBox1.ListCount

End Sub

Private Sub ListBox1_Click()

    TextBox3.Text = ListBox1

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    selName = ListBox1

    docNameLen = Len(selName)

    chkLen = InStr(selName, "-")

    selName = Left(selName, chkLen - 1)

    Documents.Open (selName)

End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    copyName = ListBox2

    Documents.Open (copyName)

End Sub

Sub getSentense()

    varCnt = ListBox1.ListCount

    fileCnt = TextBox2.Value

    targetText = TextBox4.Value

    i = 0

    Do While i < varCnt

        fileNum = i Mod fileCnt

        If fileNum = 0 Then

            If i = 0 Then

            Else

                ActiveDocument.Close SaveChanges:=wdSaveChanges

            End If

            ChangeFileOpenDirectory TextBox1.Text

            Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0

            newFileName = "복사대상" & TextBox2.Text & i + 1 & "-" & i + fileCnt & Date & Hour(Time) & Minute(Time) & Second(Time) & ".docx"

            ActiveDocument.SaveAs FileName:=newFileName

        End If

        fileVal = ListBox1.List(i)

        chkLen = InStr(fileVal, "-")

        fileVal = Left(fileVal, chkLen - 1)

        sendVal = newFileName & "*" & fileVal

        '복사할 대상을 열어 복사함

        Documents.Open FileName:=fileVal, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

'자료찾아복사하는 함수 호출함.

chkexeval = True

    Do While chkexeval = True

        Selection.Find.ClearFormatting

        With Selection.Find

            .Text = targetText

            .Replacement.Text = ""

            .Forward = True

            .Wrap = wdFindStop

            .Format = False

            .MatchCase = False

            .MatchWholeWord = False

            .MatchByte = False

            .CorrectHangulEndings = True

            .HanjaPhoneticHangul = False

            .MatchWildcards = False

            .MatchSoundsLike = False

            .MatchAllWordForms = False

        End With

        chkexeval = Selection.Find.Execute

        If chkexeval = True Then

            Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

'            Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend

            Selection.MoveRight Unit:=wdWord, Count:=7, Extend:=wdExtend

            Selection.Copy

            Selection.MoveRight Unit:=wdCharacter, Count:=1

        End If

            '새 파일을 저장한 위치로 옮김.

            ChangeFileOpenDirectory TextBox1.Text

            Documents(newFileName).Activate

            Documents(newFileName).Select

            '새파일의 맨 뒤로 이동함.

            Selection.EndKey Unit:=wdStory

            Selection.TypeParagraph

        '붙혀넣기 전에 링크를 추가함

        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _

            fileVal, SubAddress:="", ScreenTip:="", TextToDisplay:=fileVal

        '붙여 넣기함.

        Selection.PasteAndFormat (wdFormatPlainText)

        Selection.TypeText (vbTab)

        Selection.TypeText (chkexeval)

        Selection.TypeText (vbTab)

        Selection.EndKey Unit:=wdStory

        Selection.TypeParagraph

        Documents(fileVal).Activate

    Loop

        Documents(fileVal).Close

        i = i + 1

    Loop

    ActiveDocument.Save

End Sub

Sub goCopyTitle(sendVal)

        txtLen = Len(sendVal)

End Sub

outer join 시

SELECT * FROM  a LEFT OUTER JOIN b ON a.부서= b.부서

a를 기준으로 b를 조회한다 즉 아래와 같이 조회된다.

SELECT /*+gather_plan_statistics*/col_name1, col_name2, ....

  FROM table_name_1

 where key_Type = '500'

/*/통계 보기 /*/

select * from table(dbms_xplan.display_cursor(null,null,'ALLSTATS LAST'));

아내가 늘 발이 시리다고 해서 발열 덧신을 샀는데 생각보다 괜찮네요. 

usb를 통해 가열하는 제품인데 usb는 6v 정도이니 다칠 염려도 적고

전기 꽂고 1분이내에 따뜻해집니다. 좀 지나면 뜨겁다는 느낌이 듭니다. 

아내는 자기가 원하던 제품이라며 좋아하네요. 

가격도 저렴한데 사용하기 쉽고 좋습니다. 

발가락이 시려서 고생하시는 분들에게 좋은 제품입니다. 

덧신은 빨간색. 분홍색 두가지인데 빨간색으로 샀습니다. 

USB 선은 대략 1m정도 됩니다. 

선을 뺄 수도 있습니다. 

 덧신 안에 열선이 든 패드가 있습니다.

패드 가운데에 10cm 정도 되는 열선이 한가닥 들어 있습니다. 

그래서 usb 연결 후 10분 정도 지나면 발 앞부분 중앙이 뜨겁기 시작합니다 

그래도 아주 뜨겁지는 않습니다. usb 로 뜨거워 봤자 얼마나 뜨겁겠습니까?

발열패드를 신발에서 꺼낸 사진입니다. 

가운데 있는 자는 큰애가 사용하는 18cm 초등학생용 플라스틱자. 

260 남자 발에 꽉 끼네요. 

데이터아키텍처 전문가 실기문제 출제방향 및 고려사항 입니다. 

데이터베이스 진흥원에 있는 글인데 간단하게 요약하면 

1. 주관식 문제의 출제 방향