Sub allFiles_In_A_Folder2()
Dim strPath As String '폴더의 경로를 넣을 변수
Dim fileName As String '각 파일 이름을 넣을 변수
Dim xlApp As New Excel.Application '엑셀 프로그램 넣을 변수
Dim wkBk As Workbook '각 파일을 넣을 변수
Dim wkSht As Worksheet '각 시트를 넣을 변수
Dim 표 As Range '작업시트선택
Dim 수업셀 As Range '수업일수라고 적힌 셀 개체
Dim 학부모셀 As Range
Dim 수업지울셀 As Range
Dim 수업다시지울셀 As Range
Dim 학부모다시지울셀 As Range
Dim i As Integer, j As Integer, k As Integer, t As Integer
Application.ScreenUpdating = False '화면 업데이트 (일시) 정지
With Application.FileDialog(msoFileDialogFolderPicker) '폴더선택 창에서
.Show '폴더 선택창 띄우기
If .SelectedItems.Count = 0 Then '취소 선택 시
Exit Sub '매크로 종료
Else '폴더 선택시
strPath = .SelectedItems(1) & "\" '폴더 경로를 변수에 넣음
End If
End With
fileName = Dir(strPath & "*.xls*") '(폴더내)각 엑셀파일 이름을 변수에 넣음
If fileName = "" Then '폴더에 파일이 없으면
MsgBox "폴더에 파일이 없습니다." '메시지 출력
Exit Sub '매크로 중단
End If
Do While fileName <> "" '이름이 없지 않다면, 즉, 엑셀파일이 존재하면
Range("a1").Value = fileName
Set wkBk = xlApp.Workbooks.Open(strPath & fileName) '파일을 변수에 넣음
For Each wkSht In wkBk.Worksheets '열린파일 각 시트를 순환
Set 표 = wkSht.UsedRange
Set 수업셀 = 표.Find("수업") '수업이라는 내용이 있는 셀 선택
On Error Resume Next
'수업셀을 찾아다니면서 내용을 지우는 작업
For i = 0 To 17
Set 수업지울셀 = 수업셀.Offset(1, 0)
Set 수업다시지울셀 = 수업지울셀.Resize(1, 40)
수업다시지울셀.ClearContents
Set 수업셀 = 표.FindNext(after:=수업셀)
Next i
For j = 0 To 17
Set 학부모셀 = 표.Find("학부모")
'Debug.Print 학부모셀.Address
Set 학부모다시지울셀 = 학부모셀.MergeArea
학부모다시지울셀.ClearContents
Set 학부모셀 = 표.FindNext(after:=학부모셀)
'학부모셀.Select
Next j
Dim 내용지울셀 As Range
Dim 내용다시지울셀 As Range
Dim 내용다시진짜지울셀 As Range
Dim 점수셀 As Range
Set 점수셀 = 표.Find("합계")
For u = 0 To 20
Set 내용지울셀 = 점수셀.MergeArea
Set 내용다시지울셀 = 내용지울셀.Offset(0, 0)
For t = 0 To 15
For k = 0 To 12
Set 내용다시진짜지울셀 = 내용다시지울셀.MergeArea.Offset(k, t)
내용다시진짜지울셀.MergeArea.ClearContents
'Debug.Print 내용다시지울셀.MergeArea.Offset(k, 0).MergeCells
If Not 내용다시지울셀.MergeArea.Offset(k + 1, t).MergeCells Then
Debug.Print 내용다시지울셀.MergeArea.Offset(k + 1, t).Address
Exit For
End If
Next k
Next t
Set 점수셀 = 표.FindNext(after:=점수셀)
Debug.Print 점수셀.Address
Next u
Next wkSht
wkBk.Save
wkBk.Close '열려진 파일을 닫음
fileName = Dir '다음 파일을 파일이름에 넣음
Loop '무한 반복
MsgBox "매크로가 종료되었습니다." '종료 메시지창 출력
End Sub
Leave a Comment