낭만소방관

기존에 이해하기로는 한 시트당 한 파일로 저장하는 걸로 들었는데 그게 아니라 일부 시트들을 한 파일로 저장하는 내용이었다. array로만 해결하려고 머리 싸매다가 해외 사례에서 의외로 쉽게 해결. 원래 저게 내가 하고 싶던 거였는데 ㅋ 이번 작업의 핵심은 inputbox를 이용하여 시트값을 받은 후 split으로 분리하고 val 함수를 이용하여 string 값을 integer 값으로 변환해주는 것 Sub mkFile() Dim inTemp As String Dim vrTemp As Variant Dim oldBook As Workbook Dim newBook As Workbook Dim i As Integer '처리 속도 높이기 With Application .Calculation = xlCalculat..

이름을 받고, 열번호를 받아서 그에 맞는 숫자를 입력하는 매크로 자음, 모음만 분리하면 어렵지 않은 문제다. 게다가 자음, 모음 분리하는 매크로가 인터넷에 있어서 쉽게 푼 문제. Function fnName(num As Integer, inName As String) Dim 초성 As Variant, 중성 As Variant, 종성 As Variant Dim vR() As Variant Dim i As Integer, j As Integer, n As Long, k1 As Integer, k2 As Integer, k3 As Integer Dim endJoin As String Dim rngName As Range 초성 = Array("ㄱ", "ㄲ", "ㄴ", "ㄷ", "ㄸ", "ㄹ", "ㅁ", "ㅂ",..

시트명으로 파일을 저장하는 매크로. 뭔가 아쉽지만 일단 업로드. Option Explicit Sub mkFile() Dim strPath As String Dim strFile As String Dim i As Integer '저장경로를 현재 엑셀파일과 동일경로로 설정 strPath = ThisWorkbook.Path & "\" '시트1부터 시트 개수만큼 파일로 저장 For i = 1 To Sheets.Count strFile = Sheets(i).Name & ".xlsx" '시트명을 파일명으로 설정 Sheets(i).Copy '시트 복사 With ActiveWorkbook .SaveAs Filename:=strPath & strFile '현재 엑셀파일경로에 시트명으로 파일 저장 .Close '저장 후 ..

중복값을 다 나열하여 RemoveDuplicates로 중복값을 지우는 코드를 썼다가 카페의 Chronicle 님이 Collection 개체로 중복값을 찾는 방식을 알려줘서 그에 맞춰서 나도 다시 짜봤다. 중복값이 생기면 Collection에 중복값을 쌓아가고 셀에 그 배열들을 뿌리는 방식. 이를테면 공식 같은 거다. Option ExplicitSub dblName() Dim rngName As Range Dim rngCell As Range Dim cltName As New Collection Dim varName As Variant Dim i As Integer '기존항목 제거 후 제목 입력 With Range("C1") .CurrentRegion.ClearContents .Value = "중복이름" ..

빈셀이 많아서 의외로 까다로웠던 경우. resize(3,0) 이 아니라 resize(3,1) 처럼 Resize는 1이 기본값이라는 걸 뼈저리게 느꼈고 빈셀에 문자를 넣은 후 Like "[0-9]" 를 이용하여 숫자만 인식하도록 잔머리를 굴렸다. Option Explicit Sub 매크로1() Dim rngCopy As Range Dim rngStart As Range Dim rngCell As Range Dim rngArea As Range Dim intR As Integer Dim i As Integer, j As Integer Dim cntCell As Integer '기준셀, 작업시작셀, 열 수 정의 Set rngCopy = Range("C2") Set rngStart = Range("J1") in..

이런 건 쉬워서 안 올리려다가 EntireRow.Delete 를 활용해본 거라 적어서 올린다. 중복된 바코드는 없애고 유일한 바코드만 추출하여 바코드에 해당하는 수량의 합을 나타내는 매크로다. Option Explicit Sub sumCode() Dim rngCopy As Range Dim rngStart As Range Dim rngQty As Range Dim i As Integer Dim intR As Integer '원본 첫셀, 작업할 표의 첫셀, 수량 정의 Set rngCopy = Range("A1") Set rngStart = rngCopy.End(xlDown).Offset(5, 0) Set rngQty = rngStart.Offset(, 4) '기존 자료 삭제 rngStart.CurrentR..

데이터가 45만개 정도 되는 대량의 텍스트 파일이다. 원래 텍스트파일 불러오기는 1행으로 불러와지는데 이것을 수정하여 A열에만 나열하도록 했다. 코드를 약간 수정하면 100열이나 1000열 기준으로 텍스트파일을 불러올 수 있다. Option Explicit Sub impLongTxt() Dim rngImport As Range Dim strFilter As String Dim fileName As Variant Dim i As Long Dim r As Integer, c As Integer Dim strData As String Dim strChar As String Dim strText As String '기존자료 삭제 및 화면 업데이트 중지 Application.ScreenUpdating = Fals..

일별, 직원별, 시간대별 근무현황을 구하는 매크로. 배열을 써 본 처음의 매크로다. 약간 이해가 가는지도. 월간 시트에서 A1 셀을 클릭하면 된다. Option Explicit Sub qWork() Dim cntDay As Integer '일수 Dim cntTime As Integer '하루업무시간 Dim cntWorker As Integer '직원숫자 Dim var() As Integer '일자별 근무인원 넣을 배열 Dim tmWork As Range '월별 작업시간 10시 Dim tmOn As Range '직원별 출근시간 Dim i As Integer, j As Integer, k As Integer '작업 속도 높이기 Application.ScreenUpdating = False Applicatio..

분류별 최대금액을 구하고 그에 따른 판매수량과 상품명을 가져와야하는데 엑셀에서의 Offset 함수로는 왠지 잘 안 돼서 사용자정의 함수를 만들어보았다. Function fnMax(rngMax As Range, intCode As Integer) 'Max값이 나온 범위와 offset값을 받음 Dim intMax As Range 'Max값이 존재하는 셀 With rngMax Set intMax = .Find(WorksheetFunction.Max(.Cells), LookAt:=xlWhole) 'Max값이 있는 주소를 검색 End With fnMax = intMax.Offset(, -intCode) 'fnMax 함수 정의 End Function

최대로 고민하고 머리를 짰던 매크로다. 16개를 복사하고 17개부터는 다른 행부터 삽입을 해야하는 난관. 결국 select 함수와 각종 변수로 떡칠을 하여 완성했다. 책아 어서 와라. Sub 직종별양식() Dim rngWork As Range Dim rngDblWork As Range Dim snWork As Range Dim rngName As Range Dim rngStart As Range Dim i As Integer Dim j As Integer Dim k As Integer Dim x As Integer Dim y As Integer Dim z As Integer '기존 워크시트 삭제 On Error Resume Next Application.ScreenUpdating = False Appli..