-
[월보용] 데이터 합치기VB(A) 2017. 9. 1. 16:20
소방서별 데이터 합치기 코드
추가기능으로 만들었음.
나중에 쓸라고.
Option ExplicitSub Macro()Dim OldBook As WorkbookDim NewBook As WorkbookDim SingleSheet As WorksheetDim fd As FileDialogDim FileChosen%, i%Dim CopySheetIndex As IntegerDim tmp As StringDim FileName As StringWith Application.ScreenUpdating = False.Calculation = xlCalculationManual.DisplayAlerts = False.EnableEvents = FalseEnd With'월보 파일 선택Set fd = Application.FileDialog(msoFileDialogFilePicker)Set OldBook = ActiveWorkbook'파일선택 대화상자 옵션With fd.Title = "월보 파일 선택".InitialFileName = ThisWorkbook.Path.InitialView = msoFileDialogViewList.AllowMultiSelect = True.Filters.Clear.Filters.Add "월보파일을 선택하세요", "*.xls*"FileChosen = .ShowEnd WithIf FileChosen <> -1 Then Exit Sub'시트 인덱스 입력CopySheetIndex = InputBox("몇번째 시트를 복사할까요")For i = 1 To fd.SelectedItems.CountWith fdWorkbooks.Open .SelectedItems(i), , TrueFileName = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))End WithSet NewBook = ActiveWorkbooktmp = GetStationName(FileName)'시트 복사하여 붙여넣기With OldBookNewBook.Sheets(CopySheetIndex).Copy After:=.Sheets(.Sheets.Count)'동일한 시트명 있으면 시트 삭제For Each SingleSheet In .SheetsIf SingleSheet.Name = tmp Then.Sheets(tmp).DeleteExit ForEnd IfNext SingleSheet.Sheets(.Sheets.Count).Name = tmpEnd WithNewBook.CloseSet NewBook = NothingNext i'서별로 시트 줄 세우기Call SetTheLine'참조 에러를 '중부:항만'으로 수정Cells.Replace What:="#REF", Replacement:="'중부:항만'", LookAt:=xlPartWith Application.ScreenUpdating = True.Calculation = xlCalculationAutomatic.DisplayAlerts = True.EnableEvents = TrueEnd WithEnd SubFunction GetStationName(MyText As String)'관할 소방서 이름 가져오기(파일명에 ()안에 관할 소방서 이름 있으면 됨Dim Reg As ObjectWith CreateObject("Vbscript.regexp").Pattern = "\(([가-힇]+)\)".Global = FalseIf .test(MyText) ThenGetStationName = .Execute(MyText)(0).submatches(0)End IfEnd WithEnd FunctionSub SetTheLine()'서별로 줄 세우기Dim v As VariantDim i As Integerv = Array("중부", "부산진", "동래", "북부", "사하", "해운대", "금정", "남부", "강서", "기장", "항만")On Error Resume NextFor i = 0 To 10Sheets(v(i)).Move After:=Sheets(Sheets.Count)Next iOn Error GoTo 0Sheets(1).ActivateEnd SubSub Auto_Open()Auto_CloseOn Error Resume NextWith Application.CommandBars("Tools").ControlsWith .Add(Type:=msoControlButton).FaceId = 59.Caption = "소방서별 자료 취합".OnAction = "Macro"End WithEnd WithOn Error GoTo 0End SubSub Auto_Close()Application.CommandBars("Tools").ResetEnd Subcs 'VB(A)' 카테고리의 다른 글
[정규식] 텍스트 파일을 조건에 맞게 쪼개서 가져오기 (0) 2017.12.31 웹페이지 파싱 (0) 2017.09.23 월보 취합 서식 (0) 2017.08.29 난수 생성기(로또) (0) 2017.06.24 [VB.Net] 파일 생성일자로 폴더 생성 후 파일이동 (0) 2017.06.04 댓글