추세분석 매크로

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

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

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

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

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

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