한화인재경영원 신입사원 디지털 스킬 UP

Sub 파일취합_매크로()
    ' ============================================
    ' 지정 폴더의 모든 엑셀 파일을 하나의 시트로 취합
    ' ============================================

    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim lastCol As Long
    Dim fileCount As Long, totalRows As Long
    Dim isFirstFile As Boolean

    ' 폴더 선택 대화상자
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "취합할 파일이 있는 폴더를 선택하세요"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "폴더가 선택되지 않았습니다.", vbExclamation
            Exit Sub
        End If
    End With

    ' "취합" 시트 준비 (없으면 생성)
    On Error Resume Next
    Set targetWs = ThisWorkbook.Sheets("취합")
    On Error GoTo 0
    If targetWs Is Nothing Then
        Set targetWs = ThisWorkbook.Sheets.Add
        targetWs.Name = "취합"
    Else
        targetWs.Cells.Clear ' 기존 데이터 초기화
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    isFirstFile = True
    targetRow = 1
    fileCount = 0
    totalRows = 0

    ' 폴더 내 엑셀 파일 순회
    fileName = Dir(folderPath & "*.xls*")
    Do While fileName <> ""
        ' 현재 파일(자기 자신) 건너뛰기
        If fileName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
            Set ws = wb.Sheets(1)

            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

            If lastRow >= 1 Then
                If isFirstFile Then
                    ' 첫 번째 파일: 헤더 포함 복사
                    ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Copy _
                        targetWs.Cells(targetRow, 1)
                    targetWs.Cells(targetRow, lastCol + 1).Value = "원본파일"
                    targetRow = targetRow + 1
                    isFirstFile = False
                End If

                ' 데이터 복사 (헤더 제외, 2행부터)
                If lastRow >= 2 Then
                    ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, lastCol)).Copy _
                        targetWs.Cells(targetRow, 1)

                    ' 원본 파일명 기록
                    Dim i As Long
                    For i = targetRow To targetRow + (lastRow - 2)
                        targetWs.Cells(i, lastCol + 1).Value = fileName
                    Next i

                    totalRows = totalRows + (lastRow - 1)
                    targetRow = targetRow + (lastRow - 1)
                End If

                fileCount = fileCount + 1
            End If

            wb.Close SaveChanges:=False
        End If

        fileName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    ' 결과 메시지
    MsgBox "취합 완료!" & vbNewLine & _
        "처리 파일: " & fileCount & "개" & vbNewLine & _
        "취합 행수: " & totalRows & "행", vbInformation
End Sub

Sub 데이터비교_매크로()
    ' ============================================
    ' 두 시트의 데이터를 비교하여 차이점 자동 검출
    ' ============================================

    Dim ws1 As Worksheet, ws2 As Worksheet, wsResult As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, resultRow As Long
    Dim dict1 As Object, dict2 As Object
    Dim key As String
    Dim matchCount As Long, diffCount As Long
    Dim addedCount As Long, deletedCount As Long
    Dim compareColStart As Long, compareColEnd As Long
    Dim i As Long, j As Long

    ' 시트 설정
    Set ws1 = ThisWorkbook.Sheets("기준")
    Set ws2 = ThisWorkbook.Sheets("비교")

    ' "결과" 시트 준비
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("결과").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set wsResult = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsResult.Name = "결과"

    ' 결과 시트 헤더
    wsResult.Cells(1, 1).Value = "키값"
    wsResult.Cells(1, 2).Value = "상태"
    wsResult.Cells(1, 3).Value = "변경 항목"
    wsResult.Cells(1, 4).Value = "이전 값"
    wsResult.Cells(1, 5).Value = "현재 값"
    wsResult.Range("A1:E1").Font.Bold = True

    ' 비교 범위 설정 (B~F열)
    compareColStart = 2
    compareColEnd = 6

    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

    ' Dictionary로 키-행번호 매핑 (기준 시트)
    Set dict1 = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow1
        key = CStr(ws1.Cells(i, 1).Value)
        If Not dict1.Exists(key) Then dict1.Add key, i
    Next i

    ' Dictionary로 키-행번호 매핑 (비교 시트)
    Set dict2 = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow2
        key = CStr(ws2.Cells(i, 1).Value)
        If Not dict2.Exists(key) Then dict2.Add key, i
    Next i

    resultRow = 2

    ' 기준 시트 기준으로 비교
    For i = 2 To lastRow1
        key = CStr(ws1.Cells(i, 1).Value)

        If dict2.Exists(key) Then
            ' 양쪽에 존재 → 값 비교
            Dim row2 As Long
            row2 = dict2(key)
            Dim hasDiff As Boolean
            hasDiff = False

            For j = compareColStart To compareColEnd
                If CStr(ws1.Cells(i, j).Value) <> CStr(ws2.Cells(row2, j).Value) Then
                    ' 차이 발견 - 결과 기록
                    wsResult.Cells(resultRow, 1).Value = key
                    wsResult.Cells(resultRow, 2).Value = "변경"
                    wsResult.Cells(resultRow, 3).Value = ws1.Cells(1, j).Value
                    wsResult.Cells(resultRow, 4).Value = ws1.Cells(i, j).Value
                    wsResult.Cells(resultRow, 5).Value = ws2.Cells(row2, j).Value
                    resultRow = resultRow + 1

                    ' 노란색 강조
                    ws2.Cells(row2, j).Interior.Color = RGB(255, 255, 0)
                    hasDiff = True
                End If
            Next j

            If hasDiff Then
                diffCount = diffCount + 1
            Else
                matchCount = matchCount + 1
            End If
        Else
            ' 기준에만 존재 (삭제됨)
            wsResult.Cells(resultRow, 1).Value = key
            wsResult.Cells(resultRow, 2).Value = "삭제됨"
            wsResult.Cells(resultRow, 3).Value = "기준 시트에만 존재"
            resultRow = resultRow + 1
            deletedCount = deletedCount + 1
        End If
    Next i

    ' 비교 시트에만 있는 항목 (추가됨)
    For i = 2 To lastRow2
        key = CStr(ws2.Cells(i, 1).Value)
        If Not dict1.Exists(key) Then
            wsResult.Cells(resultRow, 1).Value = key
            wsResult.Cells(resultRow, 2).Value = "추가됨"
            wsResult.Cells(resultRow, 3).Value = "비교 시트에만 존재"
            resultRow = resultRow + 1
            addedCount = addedCount + 1
        End If
    Next i

    ' 결과 시트 서식 정리
    wsResult.Columns.AutoFit

    ' 요약 메시지
    MsgBox "비교 완료!" & vbNewLine & vbNewLine & _
        "일치: " & matchCount & "건" & vbNewLine & _
        "변경: " & diffCount & "건" & vbNewLine & _
        "추가: " & addedCount & "건" & vbNewLine & _
        "삭제: " & deletedCount & "건", vbInformation
End Sub

Sub 양식변경_자동화()
    ' ============================================
    ' 날짜 형식 통일, 금액 서식 정리, 공백 제거 등
    ' ============================================

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cellVal As String
    Dim fixedCount As Long

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False
    fixedCount = 0

    For i = 2 To lastRow
        ' --- A열: 앞뒤 공백 제거 ---
        ws.Cells(i, 1).Value = Trim(ws.Cells(i, 1).Value)

        ' --- B열: 날짜 형식 통일 (YYYY-MM-DD) ---
        cellVal = Trim(ws.Cells(i, 2).Value)
        If IsDate(cellVal) Then
            ws.Cells(i, 2).Value = Format(CDate(cellVal), "yyyy-mm-dd")
            ws.Cells(i, 2).NumberFormat = "yyyy-mm-dd"
            fixedCount = fixedCount + 1
        End If

        ' --- C열: 금액 - 쉼표 제거 후 숫자 변환 ---
        cellVal = Trim(ws.Cells(i, 3).Value)
        cellVal = Replace(cellVal, ",", "")
        cellVal = Replace(cellVal, "원", "")
        cellVal = Replace(cellVal, "\\, "")
        If IsNumeric(cellVal) And cellVal <> "" Then
            ws.Cells(i, 3).Value = CDbl(cellVal)
            ws.Cells(i, 3).NumberFormat = "#,##0"
            fixedCount = fixedCount + 1
        End If

        ' --- D열: 전화번호 형식 통일 (010-XXXX-XXXX) ---
        cellVal = Trim(ws.Cells(i, 4).Value)
        cellVal = Replace(cellVal, "-", "")
        cellVal = Replace(cellVal, " ", "")
        If Len(cellVal) = 11 And Left(cellVal, 3) = "010" Then
            ws.Cells(i, 4).Value = Left(cellVal, 3) & "-" & _
                Mid(cellVal, 4, 4) & "-" & Right(cellVal, 4)
            fixedCount = fixedCount + 1
        End If

        ' --- E열: 부서명 통일 (약어 → 정식 명칭) ---
        cellVal = Trim(ws.Cells(i, 5).Value)
        Select Case cellVal
            Case "인사", "인사부", "HR"
                ws.Cells(i, 5).Value = "인사팀"
                fixedCount = fixedCount + 1
            Case "총무", "총무부", "GA"
                ws.Cells(i, 5).Value = "총무팀"
                fixedCount = fixedCount + 1
            Case "재무", "재무부", "경리"
                ws.Cells(i, 5).Value = "재무팀"
                fixedCount = fixedCount + 1
            Case "기획", "기획부", "전략"
                ws.Cells(i, 5).Value = "기획팀"
                fixedCount = fixedCount + 1
        End Select
    Next i

    Application.ScreenUpdating = True

    MsgBox "양식 변경 완료!" & vbNewLine & _
        "수정된 셀: " & fixedCount & "개", vbInformation
End Sub