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

Sub CollectExperimentData()
    ' ============================================
    ' 실험 데이터 자동 취합 매크로
    ' 같은 폴더 내 모든 엑셀 파일에서 데이터를 수집합니다
    ' ============================================

    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim lastCol As Long
    Dim fileCount As Long
    Dim totalRows As Long
    Dim isFirstFile As Boolean

    ' --- 초기 설정 ---
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' 현재 파일이 있는 폴더 경로
    folderPath = ThisWorkbook.Path & "\"

    ' "통합" 시트 생성 (기존 시트가 있으면 삭제 후 재생성)
    On Error Resume Next
    ThisWorkbook.Sheets("통합").Delete
    On Error GoTo ErrorHandler

    Set wsTarget = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsTarget.Name = "통합"

    ' --- 폴더 내 엑셀 파일 순회 ---
    fileName = Dir(folderPath & "*.xlsx")
    fileCount = 0
    totalRows = 0
    isFirstFile = True

    Do While fileName <> ""
        ' 현재 파일(매크로 파일) 제외
        If fileName <> ThisWorkbook.Name Then

            ' 진행 상황 표시
            Application.StatusBar = "처리 중: " & fileName

            ' 파일 열기
            Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
            Set wsSource = wb.Sheets(1) ' 첫 번째 시트

            ' 데이터 범위 확인
            lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
            lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column

            If lastRowSource >= 2 Then
                lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row

                ' 첫 번째 파일이면 헤더 포함
                If isFirstFile Then
                    ' 헤더 복사 + "원본파일" 열 추가
                    wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(1, lastCol)).Copy _
                        wsTarget.Cells(1, 1)
                    wsTarget.Cells(1, lastCol + 1).Value = "원본파일"

                    ' 데이터 복사
                    wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastRowSource, lastCol)).Copy _
                        wsTarget.Cells(2, 1)

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

                    isFirstFile = False
                Else
                    ' 데이터만 복사 (헤더 제외)
                    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
                    wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastRowSource, lastCol)).Copy _
                        wsTarget.Cells(lastRowTarget, 1)

                    ' 원본 파일명 기록
                    For i = lastRowTarget To lastRowTarget + (lastRowSource - 2)
                        wsTarget.Cells(i, lastCol + 1).Value = fileName
                    Next i
                End If

                totalRows = totalRows + (lastRowSource - 1)
                fileCount = fileCount + 1
            End If

            ' 파일 닫기
            wb.Close SaveChanges:=False
        End If

        fileName = Dir()
    Loop

    ' --- 서식 정리 ---
    wsTarget.Columns.AutoFit
    wsTarget.Rows(1).Font.Bold = True
    wsTarget.Rows(1).Interior.Color = RGB(30, 58, 95) ' 헤더 배경색
    wsTarget.Rows(1).Font.Color = RGB(255, 255, 255) ' 헤더 글자색

    ' --- 완료 ---
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "데이터 취합 완료!" & vbNewLine & vbNewLine & _
           "처리 파일 수: " & fileCount & "개" & vbNewLine & _
           "총 데이터 행: " & totalRows & "행", vbInformation, "완료"

    Exit Sub

ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "오류가 발생했습니다: " & Err.Description, vbCritical, "오류"
End Sub

Sub GenerateReport()
    ' ============================================
    ' 원버튼 리포트 생성 매크로
    ' "통합" 시트의 데이터를 분석하여 "리포트" 시트를 생성합니다
    ' ============================================

    Dim wsData As Worksheet, wsReport As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim reportRow As Long
    Dim colIndex As Long
    Dim colName As String
    Dim dataRange As Range

    ' 데이터 시트 확인
    On Error Resume Next
    Set wsData = ThisWorkbook.Sheets("통합")
    On Error GoTo ErrorHandler

    If wsData Is Nothing Then
        MsgBox "'통합' 시트가 없습니다. 먼저 데이터를 취합해주세요.", vbExclamation
        Exit Sub
    End If

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

    ' 리포트 시트 생성
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("리포트").Delete
    On Error GoTo ErrorHandler
    Application.DisplayAlerts = True

    Set wsReport = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsReport.Name = "리포트"

    ' --- 리포트 제목 ---
    reportRow = 1
    With wsReport.Cells(reportRow, 1)
        .Value = "데이터 분석 리포트"
        .Font.Size = 16
        .Font.Bold = True
        .Font.Color = RGB(30, 58, 95)
    End With

    reportRow = 2
    wsReport.Cells(reportRow, 1).Value = "생성일: " & Format(Now, "yyyy-mm-dd hh:mm")
    wsReport.Cells(reportRow, 1).Font.Color = RGB(119, 119, 119)

    ' --- 기초 통계 섹션 ---
    reportRow = 4
    With wsReport.Cells(reportRow, 1)
        .Value = "1. 기초 통계"
        .Font.Size = 13
        .Font.Bold = True
        .Font.Color = RGB(255, 107, 0) ' 한화 오렌지
    End With

    reportRow = 5
    ' 헤더
    wsReport.Cells(reportRow, 1).Value = "항목"
    wsReport.Cells(reportRow, 2).Value = "평균"
    wsReport.Cells(reportRow, 3).Value = "표준편차"
    wsReport.Cells(reportRow, 4).Value = "최소"
    wsReport.Cells(reportRow, 5).Value = "최대"
    wsReport.Cells(reportRow, 6).Value = "데이터 수"
    wsReport.Range(wsReport.Cells(reportRow, 1), wsReport.Cells(reportRow, 6)).Font.Bold = True
    wsReport.Range(wsReport.Cells(reportRow, 1), wsReport.Cells(reportRow, 6)).Interior.Color = RGB(30, 58, 95)
    wsReport.Range(wsReport.Cells(reportRow, 1), wsReport.Cells(reportRow, 6)).Font.Color = RGB(255, 255, 255)

    ' 각 숫자 열에 대해 통계 계산
    For colIndex = 1 To lastCol
        colName = wsData.Cells(1, colIndex).Value
        If IsNumeric(wsData.Cells(2, colIndex).Value) And wsData.Cells(2, colIndex).Value <> "" Then
            reportRow = reportRow + 1
            Set dataRange = wsData.Range(wsData.Cells(2, colIndex), wsData.Cells(lastRow, colIndex))
            wsReport.Cells(reportRow, 1).Value = colName
            wsReport.Cells(reportRow, 2).Value = Round(Application.Average(dataRange), 2)
            wsReport.Cells(reportRow, 3).Value = Round(Application.StDev(dataRange), 2)
            wsReport.Cells(reportRow, 4).Value = Application.Min(dataRange)
            wsReport.Cells(reportRow, 5).Value = Application.Max(dataRange)
            wsReport.Cells(reportRow, 6).Value = Application.Count(dataRange)
        End If
    Next colIndex

    ' --- 데이터 요약 섹션 ---
    reportRow = reportRow + 2
    With wsReport.Cells(reportRow, 1)
        .Value = "2. 데이터 요약"
        .Font.Size = 13
        .Font.Bold = True
        .Font.Color = RGB(255, 107, 0)
    End With

    reportRow = reportRow + 1
    wsReport.Cells(reportRow, 1).Value = "총 데이터 행 수:"
    wsReport.Cells(reportRow, 2).Value = lastRow - 1
    reportRow = reportRow + 1
    wsReport.Cells(reportRow, 1).Value = "총 변수(열) 수:"
    wsReport.Cells(reportRow, 2).Value = lastCol

    ' --- 서식 정리 ---
    wsReport.Columns.AutoFit

    MsgBox "리포트가 생성되었습니다!", vbInformation, "완료"
    wsReport.Activate

    Exit Sub

ErrorHandler:
    Application.DisplayAlerts = True
    MsgBox "오류: " & Err.Description, vbCritical, "오류"
End Sub

Sub FetchWebData()
    ' ============================================
    ' 외부 웹 데이터 자동 수집 매크로
    ' "URL목록" 시트의 URL에서 데이터를 가져옵니다
    ' ============================================

    Dim wsURL As Worksheet, wsResult As Worksheet
    Dim http As Object
    Dim url As String
    Dim lastRow As Long, i As Long
    Dim resultRow As Long
    Dim response As String

    Set wsURL = ThisWorkbook.Sheets("URL목록")

    ' 결과 시트 준비
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("수집결과").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsResult = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsResult.Name = "수집결과"

    ' 헤더 설정
    wsResult.Cells(1, 1).Value = "URL"
    wsResult.Cells(1, 2).Value = "상태"
    wsResult.Cells(1, 3).Value = "수집일시"
    wsResult.Cells(1, 4).Value = "데이터"
    wsResult.Rows(1).Font.Bold = True

    ' HTTP 객체 생성
    Set http = CreateObject("MSXML2.XMLHTTP.6.0")

    lastRow = wsURL.Cells(wsURL.Rows.Count, 1).End(xlUp).Row
    resultRow = 2

    For i = 2 To lastRow
        url = wsURL.Cells(i, 1).Value

        If url <> "" Then
            Application.StatusBar = "수집 중: " & i - 1 & "/" & lastRow - 1

            On Error Resume Next
            http.Open "GET", url, False
            http.setRequestHeader "User-Agent", "Mozilla/5.0"
            http.send

            If Err.Number = 0 Then
                wsResult.Cells(resultRow, 1).Value = url
                wsResult.Cells(resultRow, 2).Value = http.Status & " " & http.statusText
                wsResult.Cells(resultRow, 3).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")

                ' 응답 텍스트 (첫 1000자만 저장)
                response = http.responseText
                If Len(response) > 1000 Then response = Left(response, 1000) & "..."
                wsResult.Cells(resultRow, 4).Value = response
            Else
                wsResult.Cells(resultRow, 1).Value = url
                wsResult.Cells(resultRow, 2).Value = "오류: " & Err.Description
                wsResult.Cells(resultRow, 3).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
                Err.Clear
            End If
            On Error GoTo 0

            resultRow = resultRow + 1
        End If
    Next i

    ' 서식 정리
    wsResult.Columns.AutoFit
    Application.StatusBar = False

    MsgBox "외부 데이터 수집 완료!" & vbNewLine & _
           "수집 건수: " & resultRow - 2 & "건", vbInformation, "완료"

    Set http = Nothing
End Sub