-
이런 거 혼자 만들고 치우면 되는데
결국 뿌렸네.
암튼 오랜만에 하나.
정규식 등 잡다한 기술이 들어감
Option ExplicitPrivate FileName As StringSub SumFiles()Dim OldBook As WorkbookDim NewBook As WorkbookDim SingleRange As RangeDim fd As FileDialogDim FileChosen%, i%, j%With Application.ScreenUpdating = False.Calculation = xlCalculationManual.DisplayAlerts = FalseEnd With'기존 시트 삭제If Sheets.Count > 2 ThenFor i = 3 To Sheets.CountSheets(3).DeleteNext iEnd 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 = .ShowEnd WithIf FileChosen <> -1 Then Exit Sub'월보 시트(시민참여, 현장대응) 복사하여 붙여넣기For i = 1 To fd.SelectedItems.CountWith fdWorkbooks.Open .SelectedItems(i), , TrueFileName = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))End WithSet NewBook = ActiveWorkbookWith OldBookFor j = 1 To 2NewBook.Sheets(j).Copy after:=.Sheets(.Sheets.Count).Sheets(.Sheets.Count).Name = i & "_" & SheetName(j) & "_" & GetStationName(NewBook.Sheets(j).Range("A1"))Next jEnd WithFileName = vbNullStringNewBook.CloseSet NewBook = NothingNext i'각 소방서(센터) 실적 더하기For j = 1 To 2For Each SingleRange In Sheets(j).Range("A1").CurrentRegion.SpecialCells(2, 1).CellsWith SingleRange.Value2 = 0On Error Resume NextFor i = j + 2 To Sheets.Count Step 2.Value2 = .Value2 + Sheets(i).Range(.Address(0, 0)).Value2Next iOn Error GoTo 0End WithNext SingleRangeNext j'변수 초기화Set fd = NothingSet OldBook = NothingSheets(1).ActivateWith Application.ScreenUpdating = True.Calculation = xlCalculationAutomatic.DisplayAlerts = TrueEnd WithEnd SubFunction GetStationName(MyText As String)'관할 소방서(센터) 이름 가져오기'A1셀에 부서명 없으면 파일명에서 가져옴'파일명에도 없으면 패스Dim Reg As ObjectWith CreateObject("Vbscript.regexp").Pattern = "\(([가-힇]+)\)".Global = FalseIf .test(MyText) ThenGetStationName = .Execute(MyText)(0).submatches(0)ElseIf .test(FileName) ThenGetStationName = .Execute(FileName)(0).submatches(0)ElseGetStationName = "-"End IfEnd WithEnd FunctionFunction SheetName(SheetsCount As Integer) As String'시민, 현장 시트명 지정Select Case SheetsCountCase 1: SheetName = "시민"Case 2: SheetName = "현장"End SelectEnd Functioncs 'VB(A)' 카테고리의 다른 글
웹페이지 파싱 (0) 2017.09.23 [월보용] 데이터 합치기 (0) 2017.09.01 난수 생성기(로또) (0) 2017.06.24 [VB.Net] 파일 생성일자로 폴더 생성 후 파일이동 (0) 2017.06.04 [VB.Net] 화면보호기 (0) 2017.06.03 댓글