가톨릭중앙의료원 AI 역량 집중 과정 진행 (안)

<role> 당신은 20년 경력의 Excel VBA 전문가입니다. 실무에서 대용량 데이터 처리와 자동화 솔루션을 개발해온 경험이 풍부합니다. 사용자의 요구사항을 정확히 파악하고, 안정적이고 효율적인 VBA 코드를 작성하는 것이 당신의 전문 분야입니다. </role> <task> 여러 개의 데이터 파일을 하나의 Excel 시트로 통합하는 VBA 코드를 작성해주세요. </task> <requirements> <primary_goal> 지정된 폴더 내의 모든 CSV와 Excel 파일의 데이터를 하나의 워크시트에 통합하여 새로운 파일로 저장 </primary_goal> <specific_conditions> - 폴더 경로: C:\Users\alsrb\Desktop\AI 데이터실습\drive-download-20250824T214001Z-1-001\MAPO_LIB_AIR_2022년(2022.01.03~2023.01.01)\ - 첫 번째 파일의 헤더행만 유지, 이후 파일들은 데이터만 추가 - 파일 형식: CSV (EUC-KR 인코딩), Excel (xls, xlsx) - 저장 파일명: "마포구 공기질현황_YYYY-MM-DD.xlsx" 형식 - 에러 발생 시에도 다른 파일들은 계속 처리 </specific_conditions> <technical_requirements> - 메모리 효율적인 셀 단위 복사 방식 사용 - 원본 파일들은 ReadOnly 모드로 열기 - 새 워크북으로 저장하여 원본 보호 - 포괄적인 에러 처리 및 리소스 정리 - 사용자 친화적인 진행 상황 표시 및 완료 메시지 </technical_requirements> </requirements> <sample_data> <file_structure> 폴더 내 파일 예시: - MAPO_LIB_AIR_2022.01.0301.09.csv (3,356행) - MAPO_LIB_AIR_2022.01.0310.16.csv (2,847행) - MAPO_LIB_AIR_2022.01.1723.24.csv (4,123행) </file_structure> <csv_header_example> 기관명,모델명,시리얼,데이터관측일시,온도(℃),습도(%),미세먼지(㎍/㎥),소음(㏈),이산화탄소(ppm),휘발성유기화합물(ppb),초미세먼지(㎍/㎥),학습능률지수(%),등록일자 </csv_header_example> <data_row_example> "마포구","AirGuard-K","V01G1613544","202201030855","1158","41","112","74","981","185","81","49","2022-01-03 08:59:29","","" </data_row_example> </sample_data> <edge_cases> <potential_issues> - CSV 파일의 EUC-KR 인코딩으로 인한 한글 깨짐 - 빈 파일이나 헤더만 있는 파일 - 파일 접근 권한 문제 - 메모리 부족 상황 - 중복되거나 손상된 파일 </potential_issues> </edge_cases> <instructions> 단계별로 생각하세요: 1. 먼저 전체 작업 흐름을 분석하고 2. 필요한 변수와 객체들을 정의하며 3. 파일 형식별 처리 방법을 구분하고 4. 데이터 복사 로직을 설계한 후 5. 에러 처리와 리소스 정리 방안을 수립하세요 </instructions> <response_format> 다음 형식으로 응답을 시작해주세요: ```vba Sub 마포구_공기질_데이터_통합() ' ============================================ ' 마포구 공기질 데이터 통합 프로그램 ' 작성일: [날짜] ' 기능: 폴더 내 모든 CSV/Excel 파일을 하나의 시트로 통합 ' ============================================ ' 1단계: 변수 선언 Dim folderPath As String Dim fileName As String ' [추가 변수들...] ' 2단계: 초기화 및 환경 설정 On Error GoTo ErrorHandler ' [초기화 코드...] </response_format>

Sub 마포구_공기질_데이터_종합_수정() ' 변수 선언 Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim ws As Worksheet Dim sourceWb As Workbook Dim sourceWs As Worksheet Dim lastRow As Long Dim sourceLastRow As Long Dim sourceLastCol As Long Dim isFirstFile As Boolean Dim newFileName As String Dim todayDate As String Dim processedFiles As Long Dim targetRow As Long Dim i As Long, j As Long Dim dateCol As Variant ' 등록일자 열 위치(숫자 또는 오류) ' 에러 처리 시작 On Error GoTo ErrorHandler ' 초기화 folderPath = "C:\Users\alsrb\Desktop\AI 데이터실습\drive-download-20250824T214001Z-1-001\MAPO_LIB_AIR_2022년(2022.01.03~2023.01.01)\" Set wb = ThisWorkbook Set ws = wb.Sheets("Sheet1") isFirstFile = True processedFiles = 0 todayDate = Format(Date, "yyyy-mm-dd") newFileName = "마포구 공기질현황_" & todayDate & ".xlsx" ' Sheet1 초기화 ws.Cells.Clear ' 화면 업데이트 및 경고 비활성화 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual ' CSV 파일 처리 fileName = Dir(folderPath & "*.csv") Do While fileName <> "" Application.StatusBar = "처리 중: " & fileName ' CSV 파일 열기 시도 On Error Resume Next Set sourceWb = Nothing ' CSV 파일 열기 Set sourceWb = Workbooks.Open(folderPath & fileName, _ Format:=6, _ Delimiter:=",", _ Origin:=xlWindows, _ UpdateLinks:=False) If Err.Number = 0 And Not sourceWb Is Nothing Then Set sourceWs = sourceWb.Sheets(1) ' 데이터 범위 확인 sourceLastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row sourceLastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column If sourceLastRow > 0 And sourceLastCol > 0 Then If isFirstFile Then ' 첫 번째 파일: 헤더 포함 전체 복사 (값만) For i = 1 To sourceLastRow For j = 1 To sourceLastCol ws.Cells(i, j).Value = sourceWs.Cells(i, j).Value Next j Next i targetRow = sourceLastRow + 1 isFirstFile = False processedFiles = processedFiles + 1 ' 헤더에서 "등록일자" 열 위치 파악 dateCol = Application.Match("등록일자", ws.Rows(1), 0) Else ' 두 번째 파일부터: 헤더 제외하고 복사 If sourceLastRow > 1 Then For i = 2 To sourceLastRow For j = 1 To sourceLastCol ws.Cells(targetRow, j).Value = sourceWs.Cells(i, j).Value Next j targetRow = targetRow + 1 Next i processedFiles = processedFiles + 1 End If End If End If ' 파일 닫기 (저장하지 않음) sourceWb.Close SaveChanges:=False Set sourceWb = Nothing End If Err.Clear On Error GoTo ErrorHandler fileName = Dir Loop ' Excel 파일 처리 fileName = Dir(folderPath & "*.xl*") Do While fileName <> "" If fileName <> wb.Name Then ' 현재 파일 제외 Application.StatusBar = "처리 중: " & fileName On Error Resume Next Set sourceWb = Nothing Set sourceWb = Workbooks.Open(folderPath & fileName, _ ReadOnly:=True, _ UpdateLinks:=False) If Err.Number = 0 And Not sourceWb Is Nothing Then Set sourceWs = sourceWb.Sheets(1) sourceLastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row sourceLastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column If sourceLastRow > 0 And sourceLastCol > 0 Then If isFirstFile Then ' 첫 번째 파일: 헤더 포함 전체 복사 For i = 1 To sourceLastRow For j = 1 To sourceLastCol ws.Cells(i, j).Value = sourceWs.Cells(i, j).Value Next j Next i targetRow = sourceLastRow + 1 isFirstFile = False processedFiles = processedFiles + 1 ' 헤더에서 "등록일자" 열 위치 파악 dateCol = Application.Match("등록일자", ws.Rows(1), 0) Else ' 두 번째 파일부터: 헤더 제외하고 복사 If sourceLastRow > 1 Then For i = 2 To sourceLastRow For j = 1 To sourceLastCol ws.Cells(targetRow, j).Value = sourceWs.Cells(i, j).Value Next j targetRow = targetRow + 1 Next i processedFiles = processedFiles + 1 End If End If End If sourceWb.Close SaveChanges:=False Set sourceWb = Nothing End If Err.Clear On Error GoTo ErrorHandler End If fileName = Dir Loop ' === 등록일자 열 서식 적용 (원본처럼 보여주기) === lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row If Not IsError(dateCol) And lastRow >= 2 Then With ws.Range(ws.Cells(2, CLng(dateCol)), ws.Cells(lastRow, CLng(dateCol))) .NumberFormat = "yyyy-mm-dd hh:mm" End With End If ' 결과 확인 및 저장 If lastRow > 1 Then ' 간단한 서식 적용 ws.Range("A1").CurrentRegion.Columns.AutoFit ' 새 워크북으로 저장 (현재 워크북과 분리) Dim newWb As Workbook Set newWb = Workbooks.Add ' 데이터 복사 (값 붙여넣기) ws.Range("A1").CurrentRegion.Copy With newWb.Sheets(1).Range("A1") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With ' 새 통합 파일에서도 등록일자 열 서식 재적용 Dim newDateCol As Variant, newLastRow As Long newLastRow = newWb.Sheets(1).Cells(newWb.Sheets(1).Rows.Count, 1).End(xlUp).Row newDateCol = Application.Match("등록일자", newWb.Sheets(1).Rows(1), 0) If Not IsError(newDateCol) And newLastRow >= 2 Then With newWb.Sheets(1).Range(newWb.Sheets(1).Cells(2, CLng(newDateCol)), _ newWb.Sheets(1).Cells(newLastRow, CLng(newDateCol))) .NumberFormat = "yyyy-mm-dd hh:mm" End With End If ' 저장 newWb.SaveAs folderPath & newFileName, FileFormat:=xlOpenXMLWorkbook newWb.Close SaveChanges:=False MsgBox "작업 완료!" & vbCrLf & _ "처리된 파일: " & processedFiles & "개" & vbCrLf & _ "총 행수: " & (lastRow - 1) & "행" & vbCrLf & _ "저장된 파일: " & newFileName, vbInformation Else MsgBox "처리할 데이터가 없습니다." & vbCrLf & _ "폴더 경로를 확인해주세요: " & vbCrLf & folderPath, vbExclamation End If GoTo CleanUp ErrorHandler: MsgBox "오류 발생: " & Err.Description & vbCrLf & _ "오류 번호: " & Err.Number & vbCrLf & _ "현재 처리 중인 파일: " & fileName, vbCritical CleanUp: ' 정리 If Not sourceWb Is Nothing Then sourceWb.Close SaveChanges:=False Set sourceWb = Nothing End If Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.StatusBar = False End Sub

Sub 월별_시트_분리_등록일자기준() Const SOURCE_SHEET_NAME As String = "Sheet1" ' 통합 데이터가 있는 시트명 Dim wb As Workbook, wsSrc As Worksheet Dim lastRow As Long, lastCol As Long Dim dateCol As Variant Dim i As Long, m As Long Dim val As Variant Dim wsMonth(1 To 12) As Worksheet Dim nextRow(1 To 12) As Long Dim hdr As Range Dim altHeaders As Variant, h As Variant On Error GoTo ErrH Set wb = ThisWorkbook ' 소스 시트 참조 (없으면 ActiveSheet 사용) If SheetExists(SOURCE_SHEET_NAME, wb) Then Set wsSrc = wb.Worksheets(SOURCE_SHEET_NAME) Else Set wsSrc = ActiveSheet End If ' 데이터 범위 lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row lastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column If lastRow < 2 Then MsgBox "데이터가 없습니다(헤더만 존재).", vbExclamation Exit Sub End If Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual ' 등록일자 열 찾기 (여러 후보 허용) dateCol = Application.Match("등록일자", wsSrc.Rows(1), 0) If IsError(dateCol) Then altHeaders = Array("등록 일자", "측정일시", "일시", "Date", "날짜", "작성일자") For Each h In altHeaders dateCol = Application.Match(h, wsSrc.Rows(1), 0) If Not IsError(dateCol) Then Exit For Next h End If If IsError(dateCol) Then MsgBox "헤더 행에서 '등록일자' 열을 찾을 수 없습니다." & vbCrLf & _ "헤더명을 확인하거나 코드의 대체 헤더 목록을 수정하세요.", vbCritical GoTo Clean End If ' 기존 월 시트 정리(있으면 삭제) For m = 1 To 12 If SheetExists(CStr(m) & "월", wb) Then wb.Worksheets(CStr(m) & "월").Delete End If Next m ' 월 시트 생성 + 헤더 복사 Set hdr = wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(1, lastCol)) For m = 1 To 12 Set wsMonth(m) = wb.Worksheets.Add(After:=wsSrc) wsMonth(m).Name = CStr(m) & "월" hdr.Copy Destination:=wsMonth(m).Range("A1") nextRow(m) = 2 Next m ' 본문 행을 월별로 분배 For i = 2 To lastRow val = wsSrc.Cells(i, CLng(dateCol)).Value ' 날짜 판별 및 월 추출 If IsDate(val) Then m = Month(CDate(val)) Else ' 표시문자(Text)로 들어온 경우에도 시도 val = wsSrc.Cells(i, CLng(dateCol)).Text If IsDate(val) Then m = Month(CDate(val)) Else ' 날짜 인식 안 되면 건너뜀(필요 시 로그 처리) GoTo ContinueLoop End If End If ' 행 전체를 해당 월 시트에 복사(값 기준) wsMonth(m).Cells(nextRow(m), 1).Resize(1, lastCol).Value = _ wsSrc.Cells(i, 1).Resize(1, lastCol).Value nextRow(m) = nextRow(m) + 1 ContinueLoop: Next i ' 서식 및 정리 For m = 1 To 12 With wsMonth(m) ' 등록일자 열 표시형식 On Error Resume Next .Columns(CLng(dateCol)).NumberFormat = "yyyy-mm-dd hh:mm" On Error GoTo 0 .Columns.AutoFit End With Next m MsgBox "완료: 등록일자 기준으로 월별 시트를 생성했습니다." & vbCrLf & _ "원본 시트: " & wsSrc.Name, vbInformation Clean: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Exit Sub ErrH: MsgBox "오류: " & Err.Description, vbCritical Resume Clean End Sub Private Function SheetExists(shtName As String, wb As Workbook) As Boolean Dim sht As Worksheet On Error Resume Next Set sht = wb.Worksheets(shtName) SheetExists = Not sht Is Nothing On Error GoTo 0 End Function