낭만소방관

하위폴더의 자료들을 가져오는 코드 FSO라는 것을 사용해서 하위폴더를 불러오게 되어있다. Option Explicit '매크로 시작 전 도구 - 참조 - Microsoft Scripting Runtime 에 체크할 것Sub Macro() Dim strFolderPath As String Dim objFSO As New Scripting.FileSystemObject Dim objFolder As Scripting.Folder Application.ScreenUpdating = False '현재경로 선언 strFolderPath = ThisWorkbook.Path Set objFolder = objFSO.GetFolder(strFolderPath) '기존자료 삭제 Range("A1").CurrentRegi..

스샷에 있는 숫자들은 한줄로 보면 되는 숫자들. 이 숫자들의 최대값 연속된 2개의 셀의 합의 최대값 연속된 3개의 셀의 합의 최대값 . . . 연속된 n개의 셀의 합의 최대값을 구하는 매크로 배열을 이용해 1열로 세우고 합과 최대치를 구하였다. Option Base 1Option ExplicitSub Macro() Dim rng As Range, rngA As Range Dim var1D() As Double, varMax() As Double Dim i As Integer, j As Integer, intV As Integer Dim cntC As Integer Dim rngTemp As Range '시트2의 기존값 삭제 및 영역 설정 Sheets(2).Range("A1").CurrentRegion.C..

A에는 있지만 B에는 없는 것 A에는 없지만 B에는 있는 것 A와 B동시에 있는 것 세가지 조건을 충족하기 위해 애 좀 먹었다. Option ExplicitPrivate rngWs1 As RangePrivate rngWs2 As RangePrivate wS1 As WorksheetPrivate wS2 As WorksheetPrivate wbOld As WorkbookPrivate varClt As VariantSub mkFile() Dim cltWs1 As New Collection Dim cltWs2 As New Collection Dim rng As Range Application.ScreenUpdating = False '각 시트 및 현재 워크북 변수 설정 Set wS1 = Sheets(1) Set..

대량의 데이터를 변환하는 매크로 워낙 내용이 많아서 웬만한 코드로는 실행 중 멈춰버린다. 바꿀 데이터를 배열 하나에 넣고 코드를 순환하며 바꿔주는 매크로. 핵심은, 모든 데이터를 하나의 배열에 넣는 것이다. 그리고 중요한 한가지. 코드 실행 시간이 길어질 땐 시간 체크를 해가며 이벤트를 실행해야 응답없음이 뜨지 않는다. Option ExplicitSub withArray() Dim c As Integer Dim r As Long Dim sT As Date: sT = Time '시작시간 Dim nT As Date Dim oT As Date Dim varCode As Variant: varCode = Sheets("codepyo").UsedRange '코드표를 배열로 Dim intV As Long: intV..

글자 속에 녹아있는 대괄호 안의 글자들을 맨 뒤로 보낸 뒤 다시 대괄호로 묶어주는 매크로 대괄호가 있는 것과 없는 것을 구분해서 배열에 넣은 뒤 대괄호만 따로 처리할까 고민하다가 대괄호가 있는 것만 배열에 넣고 중간에 끼인 대괄호를 없애고 앞뒤로 대괄호를 다시 붙여주고 기존 글자와 합쳐주는 단순무식한 매크로. 무언가, 배열을 멋지게 쓰고 싶었는데, 잘 모르겠다. Sub Macro() Dim stR As String Dim strR As String Dim rnG As Range Dim rngA As Range Dim varT() As String Dim i As Integer Dim j As Integer Dim k As Integer '바꿀 열 선택 Set rngA = Range("A1", Cells(..

옆에 기준 내용이 있다. 0 이 있는 곳은 0을 그대로 가져오고 나머지는 합계가 될 때까지 랜덤하게 값을 뿌려주는 매크로 Option ExplicitSub NumGenerate() Dim rng As Range Dim valR(1 To 7) As Integer Dim varA As Variant Dim i As Integer With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With Set rng = Range("D14") varA = Application.Transpose(Range("B6:B12")) Randomize Do For i = 1 To 7 If varA(i) ..

시트명과 구조가 같은 엑셀파일들의 취합 월보할 때 좋겠네 ^^ 원래는 Open구문으로 작업했는데 ADO와 배열을 사용해서 속도에 중점을 두었다. Option ExplicitPrivate vBody(20, 6) As VariantSub sumFiles() Dim wsName As String Dim rngName As Range Dim strPath As String Dim fileName As String '처리속도 향상 With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With '변수설정 및 기존자료 삭제 wsName = "현황" Set rngName = Range("D1..

1. 4개씩 뿌릴 때 첫방송은 무조건 나온다. 2. 그 이후 중복된 방송은 맨 첫타임만 나온다. 3. 4번째 편성이 아닐 땐 '연속방송' 이라는 표시를 한다. 4개 중 첫번째와 나머지 세개의 표시 조건이 달라서 중복된 코드가 생기네요. 조건이 달라도 중복된 코드가 안 나오게 하고 싶은데... Option ExplicitSub OnAirFromThisTime() Dim rnG As Range Dim rngOnAir As Range Dim vOnAir() As String Dim intV As Integer Dim cntOffset As Integer Set rngOnAir = Range("B3", Cells(Rows.Count, "B").End(3)) '프로그램이름을 순환 Range("D3").Curren..

앞서 했던 정렬과는 달리 이번엔 별도의 시트에 순위가 정해져있다. vlookup 함수를 이용해서 서로의 값을 비교해서 배열을 재정렬하는 매크로 Option ExplicitSub Macro() Dim vData() As Variant Dim vList As Variant Dim temp As Variant Dim i As Integer Dim r As Integer Dim rngData As Range Application.ScreenUpdating = False '연간판매자료 및 정렬기준표 변수 설정 Set rngData = Range("A5", Cells(Rows.Count, "A").End(xlUp)) With Sheets("정렬기준표") vList = .Range("A2", .Cells(Rows.C..

데이터가 띄엄띄엄 있어서 ADO로 불러오기엔 까다롭다.일단은 파일을 열어서 데이터를 가져오는 매크로 Option Base 1Option ExplicitSub getData() Dim rngIm As Range Dim strPath As String Dim strFile As String Dim varData As Variant Dim cntFile As Integer Dim i As Integer, j As Integer Dim wbOld As Workbook Dim wbNew As Workbook Application.ScreenUpdating = False '변수설정 Set rngIm = Range("A3") Set wbOld = ActiveWorkbook '현재 파일과 같은 폴더로 변경 ChDir ..