월보 취합 서식

이런 거 혼자 만들고 치우면 되는데

결국 뿌렸네.

암튼 오랜만에 하나.

정규식 등 잡다한 기술이 들어감

Option Explicit
Private FileName As String
 
Sub SumFiles()
 
    Dim OldBook As Workbook
    Dim NewBook As Workbook
    Dim SingleRange As Range
    Dim fd As FileDialog
    Dim FileChosen%, i%, j%
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    '기존 시트 삭제
    If Sheets.Count > 2 Then
        For i = 3 To Sheets.Count
            Sheets(3).Delete
        Next i
    End If
    
    '월보 파일 선택
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Set OldBook = ThisWorkbook
    
    '파일선택 대화상자 옵션
    With fd
        .Title = "월보 파일 선택"
        .InitialFileName = ThisWorkbook.Path
        .InitialView = msoFileDialogViewList
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "월보파일을 선택하세요", "*.xls*"
        FileChosen = .Show
    End With
    
    If FileChosen <> -1 Then Exit Sub
    
    '월보 시트(시민참여, 현장대응) 복사하여 붙여넣기
    For i = 1 To fd.SelectedItems.Count
    
        With fd
            Workbooks.Open .SelectedItems(i), , True
            FileName = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
        End With
        
        Set NewBook = ActiveWorkbook
        
        With OldBook
        
            For j = 1 To 2
            
                NewBook.Sheets(j).Copy after:=.Sheets(.Sheets.Count)
                .Sheets(.Sheets.Count).Name = i & "_" & SheetName(j) & "_" & GetStationName(NewBook.Sheets(j).Range("A1"))
                
            Next j
            
        End With
        
        FileName = vbNullString
        NewBook.Close
        Set NewBook = Nothing
        
    Next i
    
    '각 소방서(센터) 실적 더하기
    For j = 1 To 2
        
        For Each SingleRange In Sheets(j).Range("A1").CurrentRegion.SpecialCells(2, 1).Cells
        
            With SingleRange
            
                .Value2 = 0
                
                On Error Resume Next
                    For i = j + 2 To Sheets.Count Step 2
                        .Value2 = .Value2 + Sheets(i).Range(.Address(0, 0)).Value2
                    Next i
                On Error GoTo 0
                
            End With
            
        Next SingleRange
        
    Next j
    
    '변수 초기화
    Set fd = Nothing
    Set OldBook = Nothing
    Sheets(1).Activate
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
 
End Sub
 
Function GetStationName(MyText As String)
'관할 소방서(센터) 이름 가져오기
'A1셀에 부서명 없으면 파일명에서 가져옴
'파일명에도 없으면 패스
 
    Dim Reg As Object
    
    With CreateObject("Vbscript.regexp")
    
        .Pattern = "\(([가-힇]+)\)"
        .Global = False
    
        If .test(MyText) Then
            GetStationName = .Execute(MyText)(0).submatches(0)
        ElseIf .test(FileName) Then
            GetStationName = .Execute(FileName)(0).submatches(0)
        Else
            GetStationName = "-"
        End If
    
    End With
    
End Function
 
Function SheetName(SheetsCount As Integer) As String
'시민, 현장 시트명 지정
 
    Select Case SheetsCount
        Case 1: SheetName = "시민"
        Case 2: SheetName = "현장"
    End Select
    
End Function