메모 넣기(comment) - 주의 점 - 메모가 이미 추가된 곳에 메모를 넣으면 오류 발생(삭제 후 추가) - 메모에는 텍스트만 입력 가능
Sub delComment()
With ActiveSheet.Range("A1")
.Interior.ColorIndex = 0
.ClearComments
End With
End Sub
Sub addComment()
With ActiveSheet.Range("A1")
'메모 삭제
.ClearComments
.Interior.ColorIndex = 12
'메모 넣기(문자열만 입력가능, 기존 메모가 있는데 넣으면 오류발생)
.addComment ("hello world")
End With
End Sub
숫자를 문자로 변환(Format) - 주의 점 - 충분히 큰 숫자를 감안하여 long 형으로 인자를 받음
Function numberToText(num As Long) As String
numberToText = Format(num, "#,##0") ' 숫자를 포맷팅된 문자열로 변환 (예: 1,234,567)
End Function
딕셔너리(Dictionary) - 착안 점 - 엑셀은 행, 열의 2차원 배열임. - key 에는 데이터의 중복이 없는 키 값을 넣고 - value 에는 행번호를 넣고 - 나머지 컬럼 번호는 Enum 으로 처리하여 - A-B 시트를 키값으로 매칭하여 데이터를 가져오는 코드를 작성가능 ex) 하나의 통일된 서식을 여러 부서에 뿌려서 취합할 경우 유용한 코딩 기법
Sub GetValuesFromSheet2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim dict1 As Object
Dim dict2 As Object
Dim key1 As String
Dim key2 As String
Dim i As Long
Dim j As Long
' 시트 설정
Set ws1 = ThisWorkbook.Sheets("1번 시트")
Set ws2 = ThisWorkbook.Sheets("2번 시트")
' 딕셔너리 생성
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
' 1번 시트 값 저장
For i = 2 To ws1.UsedRange.Rows.Count
key1 = ws1.Cells(i, 1).Value & "," & ws1.Cells(i, 2).Value
dict1.Add key1, i
Next
' 2번 시트 값 저장
For j = 2 To ws2.UsedRange.Rows.Count
key2 = ws2.Cells(j, 1).Value & "," & ws2.Cells(j, 2).Value
dict2.Add key2, j
Next
' 2번 시트 값 가져오기
For i = 2 To ws1.UsedRange.Rows.Count
key1 = ws1.Cells(i, 1).Value & "," & ws1.Cells(i, 2).Value
If dict2.Exists(key1) Then
ws1.Cells(i, 4).Value = ws2.Cells(dict2(key1), 4).Value
End If
Next
' 메모리 해제
Set dict1 = Nothing
Set dict2 = Nothing
End Sub
Body 영역선택(currentRegion & offset & resize) - 내용 : header를 제외한 내용만 선택하는 코드
' ======================================================================================
' 설명: 데이터 시작 행부터 끝까지의 전체 데이터 범위를 설정하는 서브루틴
' ======================================================================================
Sub seletAllData()
Dim DATA_START_ROW As Integer '데이터 시작 행 번호를 저장할 변수
Dim allRange As Range '전체 데이터 범위를 저장할 변수
DATA_START_ROW = 2 '데이터 시작 행 번호를 2로 설정
' 전체 데이터 범위 설정
With Range("A1").CurrentRegion
Set allRange = .Offset(DATA_START_ROW - 1).Resize(.Rows.Count - DATA_START_ROW + 1)
' A1 셀의 현재 데이터 영역에서 DATA_START_ROW 행부터 데이터가 끝나는 행까지의 범위를 allRange에 저장
End With
allRange.Select '전체 데이터 범위 선택 (주석 처리됨)
End Sub
Column 영역선택(columns) - 내용 : header를 제외한 내용 중 특정 컬럼 영역만 선택
'======================================================================================
' 설명: 데이터 시작 행부터 끝까지의 특정 컬럼 데이터 범위를 선택하는 서브루틴
' ======================================================================================
Sub selectColData()
Dim DATA_START_ROW As Integer '데이터 시작 행 번호를 저장할 변수
Dim allRange As Range '전체 데이터 범위를 저장할 변수
Dim colNum As Integer '선택할 컬럼 번호를 저장할 변수
DATA_START_ROW = 2 '데이터 시작 행 번호를 2로 설정
colNum = 1 '선택할 컬럼 번호를 1로 설정 (A 열)
' 전체 데이터 범위 설정
With Range("A1").CurrentRegion
Set allRange = .Offset(DATA_START_ROW - 1).Resize(.Rows.Count - DATA_START_ROW + 1)
' A1 셀의 현재 데이터 영역에서 DATA_START_ROW 행부터 데이터가 끝나는 행까지의 범위를 allRange에 저장
End With
allRange.Columns(colNum).Select '전체 데이터 범위에서 colNum 번째 컬럼을 선택
End Sub
파일순회
Sub PrintFilesWithSpecificExtension()
Dim fileName As String
Dim extension As String
' 출력할 확장자 설정
extension = "*.hw*" ' 예: .txt 파일
' 현재 폴더에서 첫 번째 파일 이름 가져오기
fileName = Dir(extension)
' 파일 이름이 있는 동안 반복
Do While fileName <> ""
Debug.Print fileName
' 다음 파일 이름 가져오기
fileName = Dir
Loop
End Sub
파일순회 및 파일 내용 출력
Sub PrintFilesWithSpecificExtension()
Dim pathName As String
Dim fileName As String
Dim extension As String
pathName = ThisWorkbook.Path & "\취합폴더\"
' 출력할 확장자 설정
extension = pathName & "*.xl*" '
' 현재 폴더에서 첫 번째 파일 이름 가져오기
fileName = Dir(extension)
' 파일 이름이 있는 동안 반복
Do While fileName <> ""
Debug.Print fileName
Call fileOpenAndClose(pathName & fileName)
' 다음 파일 이름 가져오기
fileName = Dir
Loop
End Sub
Function fileOpenAndClose(fileName As String)
'Dim fileName As String
Dim targetWb As Workbook
'fileName = "3.신속집행계획(총무과).xlsx"
'파일 열기
Set targetWb = Workbooks.Open(fileName)
Debug.Print (targetWb.Worksheets(1).Range("A1").Value)
'파일 저장 없이 닫기
targetWb.Close savechanges:=False
End Function
Sub fileOpenAndClose_test()
Dim pathName As String
Dim fileName As String
fileName = "3.신속집행계획(총무과).xlsx"
pathName = ThisWorkbook.Path & "\취합폴더\"
Call fileOpenAndClose(pathName & fileName)
End Sub
파일순회 및 이름변경
Function 파일이름변경(oldFileName, newFileName)
' 파일명 변경
Name oldFileName As newFileName
End Function
Sub 제출부서카운트()
Dim 폴더경로 As String, 파일명 As String
Dim 부서명 As String
Dim 제출여부확인시트 As Worksheet
Dim 부서명리스트 As Range
'부서명 = "도시재생과"
Application.ScreenUpdating = False
폴더경로 = ThisWorkbook.Path & "\취합폴더\" '폴더경로 설정
파일명 = Dir(폴더경로 & "*.xls*") '폴더 내의 모든 파일 목록 가져오기
'제출여부확인 시트를 추가하고, 부서명 리스트를 작성
Set 제출여부확인시트 = ActiveSheet
With 제출여부확인시트
'부서명리스트 세팅
Set 부서명리스트 = Range(.Range("B2"), .Range("B2").End(xlDown))
End With
'Debug.Print (rng.Value)
Do While 파일명 <> ""
For Each rng In 부서명리스트
'Debug.Print (파일명 & "- " & rng.Value)
'파일명에 부서명이 있으면
If InStr(1, 파일명, rng.value) > 0 Then
'Debug.Print (파일명)
rng.Offset(, 1).value = 1 + rng.Offset(, 1).value
If InStr(1, 파일명, rng.Offset(, -1).value & ".") = 0 Then
Call 파일이름변경(폴더경로 & 파일명, _
폴더경로 & rng.Offset(, -1).value & "." & 파일명)
End If
End If
Next
파일명 = Dir '다음 파일 이름 가져오기
Loop
Application.ScreenUpdating = True
End
파일 열고 닫기
Sub fileOpenAndClose()
Dim fileName As String
Dim targetWb As Workbook
fileName = "3.신속집행계획(총무과).xlsx"
'파일 열기
Set targetWb = Workbooks.Open(ThisWorkbook.Path & "\취합폴더\" & fileName)
'파일 저장 없이 닫기
targetWb.Close savechanges:=False
End Sub
중복값 제거 - 특정 데이터의 컬럼영역에 대해 중복값 제거
' ======================================================================================
' 설명: 활성 시트의 B 열에서 중복된 데이터를 제거하는 서브루틴
' ======================================================================================
Sub removeDuplicateData()
With ActiveSheet
' B2 셀부터 B 열의 마지막 행까지 범위 선택
' 선택된 범위에서 B 열(1번째 열)을 기준으로 중복 데이터 제거
' Header 옵션을 xlNo로 설정하여 첫 번째 행을 헤더로 취급하지 않음
Range(.Range("B2"), .Range("B2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub
Enum - 주로 컬럼명에 매칭하여 사용
Public Enum TargetColumns
DATA_START_ROW = 4
회계 = 1
부서 = 2
사업 = 3
통계목 = 4
당해예산액 = 6
이월예산액 = 8
기집행액 = 12
End Enum
