DB 데이터 관리
동적범위 함수이용해서 코드를 짧게엑셀VBA기본20강 – VBA쉽게 하고 싶으면 함수를 활용해요! Offset 함수로 코드 줄이기
사용자정의 함수
함수
셀에 사진넣기
시트숨기기 / 취소
문자를 숫자로변환
노트
노트-정리
노트-정리1
노트-정리2
사용자정의 함수
Sub 노란색()
ActiveCell.interior.color = vbyellow
End Sub
// 문자와 숫자중에서 숫자만 추출하는 VBA 함수
Function 숫자만(ByVal 문자열 As String) As Long
Dim T() As String
For i = 1 To Len(문자열)
If IsNumeric(Mid(문자열, i, 1)) Then
ReDim Preserve T(n)
T(n) = Mid(문자열, i, 1)
n = n + 1
End If
Next i
숫자만 = Val(Join(T))
End Function
Sub ChamgeCategory()
Application.MacroOptions Macro:=”숫자만”, Category:=7
End Sub
함수
Sub 배열()
‘ 시트의 셀에 1~10000번째까지 숫자기록 매크로
Dim i As Double
Dim Rev(10000) As Double
For i = 1 To 10000
Rev(i – 1) = i * 1
Next i
Range(“B7”).Resize(10000) = Application.Transpose(Rev)
End Sub
Sub 노란색()
‘ 노란 매크로
Astivecell.Interior.Color = vbYellow
End Sub
Function 숫자만(ByVal 문자열 As String) As Long
Dim T() As String
For i = 1 To Len(문자열)
If IsNumeric(Mid(문자열, i, 1)) Then
ReDim Preserve T(n)
T(n) = Mid(문자열, i, 1)
n = n + 1
End If
Next i
숫자만 = Val(Join(T))
End Function
Sub ChangeCategory()
‘사용자 함수를 모든 엑셀문서에 사용하게 할 수 있는 VBA
Application.MacroOptions Macro:=”숫자만”, Category:=7
End Sub
Function Concattxt(ByVal 범위 As Range, 구분자 As String) As String
‘셀에 있고 빈칸을 여과하고 다른 셀에 셀의 내용을 기록한다. 2020.03.08
Dim rng As Range
Dim Rev() As Variant
Dim n As Integer
For Each rng In 범위.SpecialCells(2)
If Len(rng.Value) Then
ReDim Preserve Rev(n)
Rev(n) = rng.Value
n = n + 1
End If
Next rng
Concattxt = Join(Rev, 구분자)
End Function
Sub 저장()
‘
‘ 저장 매크로
‘
‘ 바로 가기 키: Ctrl+s
‘
ChDir “N:. Personal_folderPG전기요금전기요금단가표”
ActiveWorkbook.SaveAs Filename:= _
“N:. Personal_folderPG전기요금전기요금단가표kepco_pri-3-2.xls”, FileFormat:= _
xlExcel8, Password:=””, WriteResPassword:=””, ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
Sub gbs123()
‘ gbs123 매크로= gje.co.kr에서 카피한 자료 정리하기 2020.03.08
Range( _
“2:2,13:13,14:21,24:32,35:43,46:54,57:65,68:76,79:87,90:98,101:109,112:120,123:131” _
).Select
Selection.Delete Shift:=xlUp
Range(“F5”).Select
End Sub
Sub 사이버자료이전()
‘ 사이버자료이전 매크로 gbs123으로 정리한 자료를 시트123에 정리해 주는VBA
Range(“C11”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C”
Range(“C11”).Select
Selection.AutoFill Destination:=Range(“C11:F11”), Type:=xlFillDefault
Range(“C11:F11”).Select
Range(“F11”).Select
Selection.AutoFill Destination:=Range(“F11:I11”), Type:=xlFillDefault
Range(“F11:I11”).Select
Range(“D11:I11”).Select
Selection.AutoFill Destination:=Range(“D11:I12”), Type:=xlFillDefault
Range(“D11:I12”).Select
Range(“C11:I12”).Select
Selection.AutoFill Destination:=Range(“C11:I34”), Type:=xlFillDefault
Range(“C11:I34”).Select
Range(“C4:D4”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C”
Range(“C4:D4”).Select
Selection.AutoFill Destination:=Range(“C4:D7”), Type:=xlFillDefault
Range(“C4:D7”).Select
Range(“F4:G4”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C[-1]”
Range(“F5:H5”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C[-1]”
Range(“F6”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C[-1]”
Range(“F7”).Select
ActiveCell.FormulaR1C1 = “=’123′!R[-1]C[-1]”
Range(“A8:J8”).Select
End Sub
셀에 사진넣기
Sub insert_Pic()
Dim Pic As Variant
‘셀에 사진넣기(2020-05-10 골드벨스타)
Pic = Application.GetOpenFilename(filefilter:=”Picture Files,*.jpg;*.bmp;*.tif;*.gif;*.png”)
If Pic = False Then Exit Sub
With ActiveSheet.Pictures.Insert(Pic).ShapeRange
.LockAspectRatio = msoFalse
.Height = Selection.Height – 4
.Width = Selection.Width – 4
.Left = Selection.Left + 2
.Top = Selection.Top + 2
End With
End Sub
=============================================================================
Sub add_Pic()
Dim DobuleJ As Variant
DobuleJ = Application.GetOpenFilename(filefilter:=”Picture Files,*.jpg;*.bmp;*.tif;*.gif;*.png”)
If DobuleJ = False Then
Exit Sub
End If
With ActiveSheet.Shapes.AddPicture(DobuleJ, False, True, Selection.Left, Selection.Top, Selection.Width, Selection.Height)
.LockAspectRatio = msoFalse
End With
End Sub
시트숨기기 / 취소
Sub sheets_open()
‘시트숨기기 취소
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Sheets
wks.Visible = True
Next wks
End Sub
Sub 시트보이기()
Dim ws As Worksheet, rng As Range
With Sheets(“sheet1”)
Set rng = .Range(“A5”, .Cells(Rows.Count, 1).End(xlUp))
End With
For Each ws In Sheets
If WorksheetFunction.CountIf(rng, ws.Name) > 0 Then
If ws.Visible <> xlSheetVisible Then
ws.Visible = xlSheetVisible
End If
End If
Next
End Sub
Option Explicit
Sub 시트보이기()
Dim ws As Worksheet, rng As Range
With Sheets(“sheet1”)
Set rng = .Range(“A5”, .Cells(Rows.Count, 1).End(xlUp))
End With
For Each ws In Sheets
If WorksheetFunction.CountIf(rng, ws.Name) > 0 Then
If ws.Visible <> xlSheetVisible Then
ws.Visible = xlSheetVisible
End If
End If
Next
End Sub
문자를 숫자로변환
Option Explicit
Sub convert_Text_To_Numbers_2() ‘문자로 입력된 숫자 숫자로 변환
Dim rngC As Range ‘각 셀을 순환할 변수
Application.ScreenUpdating = False ‘화면 업데이트 (일시) 중지
For Each rngC In ActiveSheet.UsedRange ‘현재시트 사용영역 각 셀을 순환
If rngC.Errors.Item(xlNumberAsText).Value = True Then
‘셀의 숫자가 문자로 입력된 경우라면
rngC.NumberFormatLocal = “0_ ” ‘셀서식을 숫자로
rngC = rngC * 1 ‘(숫자로 변환하기 위해)셀에 1을 곱함
End If
Next rngC
End Sub
노트
<01-8 합집합>
Dim c As Range, uni As Range
For Each c In Range(“a1:a10”)
If c = 4 Or c = 6 Then ‘셀의 값이 4 또는 6이면 무시해라
Else ‘4 또는 6이 아니면 아래 코드 실행
If uni Is Nothing Then ‘처음에는 uni변수에 아무것도 없으므로
Set uni = c ‘uni 변수에 c변수에 들어온 값을 넣고
Else ‘두번째 부터는 uni변수에 값이 들어오므로
Set uni = Union(uni, c) ‘기존 uni변수에 보관된 셀과 새로운 c변수의 값을 합함
End If
End If
Next
If uni Is Nothing = 0 Then uni.Select ‘uni변수에 보관된 셀이 있으면 선택해라
<01-9 교집합>
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(“b”)) Is Nothing Then ‘B열에 값이 바뀌면
Application.EnableEvents = False ‘실행문을 한번만 실행
‘To do
Application.EnableEvents = True ‘다시 이벤트 동작을 활성화
End If
End Sub
<02-5 행 삭제 개선1>
Dim uni As Range
Dim i As Long, lR As Long
lR = Cells(Rows.Count, “a”).End(xlUp).Row
For i = 2 To lR
If Cells(i, “a”) = “A-1” Then
If uni Is Nothing Then
Set uni = Cells(i, “a”).Resize(, 2)
Else
Set uni = Union(uni, Cells(i, “a”).Resize(, 2))
End If
End If
Next
If Not uni Is Nothing Then uni.Delete
<02-6 행 삭제 개선2>
Dim r, Dim a()
Dim i As Long, j As Long, k As Long
r = Range(“a1”, Cells(Rows.Count, “b”).End(xlUp)) ‘raw data를 몽땅 r변수에 넣음
For i = 1 To UBound(r, 1)
If Cells(i, “a”) <> “A-1” Then ‘A-1이 아니면 배열에 넣음
k = k + 1
ReDim Preserve a(1 To 2, 1 To k) ‘기존 배열을 유지하면서
For r = 1 To 2
a(r, k) = Cells(i, “a”).Offset(0, r – 1).Value
Next
End If
Next
Range(“a1”).CurrentRegion.ClearContents ‘기존 데이터를 모두 삭제
Range(“a1”).Resize(UBound(a, 2), 2) = Application.Transpose(a) ‘배열 값을 뿌리기
<03-4 셀 병합 해제>
Dim rng As Range, c As Range
Set rng = Range(“a1”, Cells(Rows.Count, “a”).End(3))
For Each c In rng
If c.MergeCells Then
With c.MergeArea
.UnMerge
.Value = c
End With
End If
Next
<04-5 문자 합치기>
Dim a()
Dim c As Range
Dim i As Long
For Each c In Columns(“a”).SpecialCells(2)
ReDim Preserve a(i)
a(i) = c
i = i + 1
Next
Range(“b1”) = Join(a, “,”)
<04-6 문자 나누기>
Dim s() As String
Dim i As Long
s = Split(Range(“a1″), ” “)
For i = 0 To UBound(s)
Cells(i + 1, “b”) = s(i)
Next
———————————————–
Dim s
Dim i As Long
s = Split(Range(“a1″), ” “)
For i = 0 To UBound(s)
Cells(i + 1, “b”) = s(i)
Next
———————————————-
Dim s
Dim i As Long
For Each s In Split(Range(“a1″), ” “)
Cells(i + 1, “b”) = Trim(s)
i = i + 1
Next
<05-1 컬렉션 개체로 특정 영역의 데이터 한방에 담기>
Dim nc As New Collection
Dim i As Long
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
For Each c In rng
nc.Add c.Value
Next
<05-2 컬렉션 개체로 조건에 맞는 데이터만 한방에 담기>
Dim nc As New Collection
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
For Each c In rng
If c = “A” Then
nc.Add c.Offset(, 1).Value
End If
Next
<05-3 컬렉션 개체로 중복되지 않은 고유한 항목만 담기>
Dim nc As New Collection
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
On Error Resume Next ‘반드시 넣어 주어야 함
For Each c In rng
If Len(c) Then
nc.Add c.Value, CStr(c)
End If
Next
On Error GoTo 0 ‘반드시 넣어 주어야 함
<06-1 특정 파일의 존재여부 확인>
Dim FN As String
FN = Dir(Environ(“userprofile”) & “DesktopTesttest.xlsx”)
If FN <> “” Then
MsgBox FN
Else
MsgBox “파일이 존재하지 않습니다”
End If
<06-2 특정 폴더의 존재 여부 확인>
Dim PN As String
Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN, vbDirectory)
If FN <> “” Then
MsgBox FN & ” 존재”
Else
MsgBox “해당 폴더가 존재하지 않음”
End If
<06-3 특정 폴더의 존재 여부 확인해서 없으면 만들기>
Dim PN As String
Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN, vbDirectory)
If FN <> “” Then
MsgBox FN & ” 폴더가 존재합니다”
Else
MkDir PN
MsgBox “폴더가 만들어졌습니다”
End If
<06-4 특정 폴더 내, 모든 폴더 및 파일 이름 가져오기>
Dim FN As String
FN = Dir(Environ(“userprofile”) & “DesktopTest”, vbDirectory)
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN
FN = Dir()
Loop
<06-5 특정 폴더 내, 모든 폴더의 이름 가져오기>
Dim PN As String
Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN, vbDirectory)
Do While FN <> “”
If GetAttr(PN & FN) = vbDirectory Then ‘getattr함수를 사용하여 dir함수가 반환한 이름이 파일? 폴더? 디렉토리? 인지 확인할 수 있다
Cells(Rows.Count, “a”).End(3)(2) = FN
End If
FN = Dir()
Loop
<06-6 특정 폴더 내, 모든 파일의 이름 가져오기>
Dim PN As String
Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN)
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN
FN = Dir()
Loop
<06-7 특정 폴더 내, 첫번째 엑셀 파일의 이름 가져오기>
Dim FN As String
Dim PN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN & “*.xls*”)
MsgBox FN
<06-8 특정 폴더 내, 모든 엑셀 파일의 이름 가져오기>
Dim PN As String
Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN & “*.xls*”)
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN
FN = Dir()
Loop
<06-9 특정 폴더 내, 모든 엑셀 파일 통합하기>
Dim PN As String
Dim FN As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN & “*.xls*”)
If FN = “” Then
MsgBox “폴더에 파일이 없습니다”
Exit Sub
End If
‘to do
Do While FN <> “”
Set wb = Workbooks.Open(Filename:=PN & FN, UpdateLinks:=0)
Set ws = wb.Sheets(1)
‘to do
wb.Close False
FN = Dir()
Loop
Application.ScreenUpdating = True
Set wb = Nothing
Set ws = Nothing
<06-10 특정 파일만 자동으로 가져와서 작업하기>
Dim FN As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
FN = Environ(“userprofile”) & “DesktopTestTest.xlsx”
If IsFileExist(FN) = False Then
MsgBox “파일이 존재하지 않습니다”
Exit Sub
End If
If IsFileOpen(FN) = True Then
MsgBox “파일이 이미 열려 있습니다. 닫고 다시 시작하세요”
Exit Sub
End If
Set wb = Workbooks.Open(Filename:=FN, UpdateLinks:=0)
Set ws = wb.Sheets(1)
‘to do
wb.Close False
Application.ScreenUpdating = True
Set wb = Nothing
Set ws = Nothing
‘—————————————————————————-
Function IsFileExist(FN As String) As Boolean
IsFileExist = (Dir(FN) <> “”)
End Function
‘—————————————————————————–
Function IsFileOpen(FN As String) As Boolean
Dim OpenFName As Workbook
On Error Resume Next
Set OpenFName = Workbooks(Dir(FN))
IsFileOpen = (Err.Number = 0)
End Function
<06-11 특정 폴더를 유저가 선택해서 파일 통합하기>
Dim PN As String
Dim FN As String
Dim wb As Workbook
Dim ws As Worksheet
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
PN = .SelectedItems(1) & “”
End If
End With
FN = Dir(PN & “*.xls*”)
If FN = “” Then
MsgBox “폴더에 파일이 없습니다”
Exit Sub
End If
Do While FN <> “”
Set wb = Workbooks.Open(Filename:=PN & FN, UpdateLinks:=0)
Set ws = wb.Sheets(1)
‘To do
wb.Close False
FN = Dir()
Loop
Application.ScreenUpdating = True
Set wb = Nothing
Set ws = Nothing
<06-12 특정한 파일을 유저가 선택해서 작업하기>
Dim FD As FileDialog
Dim FN As Variant
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
ChDir ThisWorkbook.Path
Application.FileDialog(msoFileDialogFilePicker).Filters.Add “Excel Files”, “*.xls*”
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.AllowMultiSelect = True ‘여러개 파일 선택
‘.AllowMultiSelect = False ‘한 개 파일 선택
If .Show Then
For Each FN In .SelectedItems
Set wb = Workbooks.Open(Filename:=FN, UpdateLinks:=0)
Set ws = wb.Sheets(1)
‘To do
wb.Close False
Next
End If
End With
Application.ScreenUpdating = True
Set wb = Nothing
Set ws = Nothing
<06-13 워크시트를 새 파일로 생성하기>
Dim PN As String, FN As String
Application.ScreenUpdating = False
PN = ThisWorkbook.Path & “”
FN = ActiveSheet.Name & “.xlsx”
If Dir(PN & FN) <> “” Then Kill PN & FN
ActiveSheet.Copy
ActiveSheet.Buttons.Delete
ActiveWorkbook.SaveAs Filename:=PN & FN
ActiveWorkbook.Close
Application.ScreenUpdating = True
<06-14 모든 워크시트를 각각의 새 파일로 생성하기>
Dim PN As String, FN As String
Dim sh As Worksheet
Application.ScreenUpdating = False
PN = ThisWorkbook.Path & “”
For Each sh In ThisWorkbook.Worksheets
FN = sh.Name & “.xlsx”
If Dir(PN & FN) <> “” Then Kill PN & FN
sh.Copy
ActiveSheet.Buttons.Delete
ActiveWorkbook.SaveAs Filename:=PN & FN
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Set sh = Nothing
<08 시트 통합>
Dim sh As Worksheet
Application.ScreenUpdating = False
Sheet1.Cells.Clear
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> ActiveSheet.Name Then
‘To do
End If
Next
Application.ScreenUpdating = True
<09-1 정렬 기본>
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
ActiveSheet.Sort.SortFields.Clear
rng.Sort Range(“a1”), 1, Header:=xlYes
‘rng.Sort Range(“a1”), 2, Header:=xlYes
<09-2 여러 필드 정렬(3개까지)>
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
ActiveSheet.Sort.SortFields.Clear
With rng
.Sort key1:=.Cells(1, 1), order1:=2, _
key2:=.Cells(1, 2), order2:=1, _
key3:=.Cells(1, 3), order3:=1, _
Header:=xlYes
End With
<09-3 여러 필드 정렬(3개 이상)>
Dim i As Long
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
With ActiveSheet.Sort
.SortFields.Clear
For i = 1 To rng.Columns.Count
.SortFields.Add Key:=Cells(1, i), Order:=2
Next
.SetRange rng
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
<10-1 자동 필터>
Dim sh1 As Worksheet
Dim rng As Range
Set sh1 = Sheets(“자동필터”)
Set rng = sh1.Range(“a1”).CurrentRegion
If sh1.AutoFilterMode = 0 Then rng.AutoFilter
If sh1.FilterMode Then sh1.ShowAllData
rng.AutoFilter 2, Range(“e2”)
Range(“a22”).CurrentRegion.Clear
If rng.SpecialCells(xlCellTypeVisible).Count = 3 Then
MsgBox “해당되는 데이터 없음”
sh1.ShowAllData
Exit Sub
End If
rng.SpecialCells(xlCellTypeVisible).Copy Range(“a22”)
sh1.ShowAllData
<10-2 고급 필터>
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
rng.AdvancedFilter xlFilterCopy, Range(“e1:e2”), Range(“a25”)
<11-1 Find 기본>
Dim rng As Range, cf As Range
Range(“e2”).ClearContents
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(xlUp))
Set cf = rng.Find(Range(“d2”).Value, , , xlWhole)
If Not cf Is Nothing Then
Range(“e2”) = cf.Offset(, 1)
Else
MsgBox “찾는 제품코드가 없습니다.”
End If
<11-2 Find 응용>
Dim rng As Range, cf As Range
Dim adr As String
Dim i As Long
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(xlUp))
Set cf = rng.Find(“A-1”, , , xlWhole)
If Not cf Is Nothing Then
adr = cf.Address
Do
cf.Interior.ColorIndex = 43
Set cf = rng.FindNext(cf)
Loop Until cf.Address = adr
End If
<12-1 피벗 생성 기본>
Dim pt As PivotTable
Dim pc As PivotCache
Dim sd As Worksheet, ss As Worksheet
Dim rngS As Range, rngD As Range
Application.ScreenUpdating = False
Set ss = Sheets(“raw”) ‘raw data 시트
Set sd = Sheets(“피벗”) ‘피벗 생성될 시트
Set rngS = ss.Range(“a1”).CurrentRegion ‘피벗의 원본 데이터 범위
Set rngD = sd.Range(“a1”) ‘피벗 생성될 시작 셀
sd.Cells.Clear
Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngS) ‘피벗 캐쉬 영역이 먼저 생성
Set pt = pc.CreatePivotTable(rngD, “pv1”) ‘캐쉬 영역을 기반으로 피벗 생성
With pt
.AddFields “연령”, “발신지_구” ‘연령별(행), 발신지구별(열)
.AddDataField .PivotFields(“통화건수”), , xlSum ‘통화건수(∑값)의 합계
End With
Application.ScreenUpdating = True
Set sd = Nothing
Set ss = Nothing
Set rngS = Nothing
Set rngD = Nothing
<12-2 피벗 생성 기본 Plus>
Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngS) ‘피벗 캐쉬 영역이 먼저 생성
Set pt = pc.CreatePivotTable(rngD, “pv1”) ‘캐쉬 영역을 기반으로 피벗 생성
With pt
.AddFields “연령”, “발신지_구” ‘연령별(행), 발신지구별(열)
.AddDataField .PivotFields(“통화건수”), , xlSum ‘통화건수(∑값)의 합계
.RowAxisLayout xlTabularRow ‘보고서 레이아웃 : 테이블 형식
.RowGrand = False ‘행 총합계 표시 안함
.ColumnGrand = False ‘열 총합계 표시 안함
For Each f In .PivotFields ‘필드별 부분합 표시 안함
f.Subtotals(1) = False
Next
End With
<12-4 피벗 슬라이서 생성과 위치 지정>
Dim scc As SlicerCache
Dim scr As Slicer
Dim ss As Worksheet
Dim pt As PivotTable
Dim rng As Range
Set ss = Sheets(“피벗”)
Set pt = ss.PivotTables(“pv1”)
On Error Resume Next
ThisWorkbook.SlicerCaches(“성별_scc”).Delete
On Error GoTo 0
Set scc = ThisWorkbook.SlicerCaches.Add2(pt, “성별”, “성별_scc”)
Set scr = scc.Slicers.Add(ss, , “성별슬라이서”, “성별선택”)
Set rng = ss.PivotTables(“pv1”).TableRange1
scr.Top = rng.Top
scr.Left = rng.Left + rng.Width + 20
scr.Height = rng.Height
scr.Width = 200
<13-1 차트 생성 기본>
Dim ws As Worksheet
Dim rs As Range, rd As Range
Dim sh As Shape
Dim ch As Chart
Set ws = Sheets(“raw”) ‘raw 시트
Set rs = ws.Range(“a1:b10”) ‘a1:b10영역이 차트 원본 영역
On Error Resume Next
ws.ChartObjects.Delete ‘raw 시트에 차트가 있으면 삭제
On Error GoTo 0
‘차트생성 : 차트는 shape > chart 순으로 만들어짐
Set sh = ws.Shapes.AddChart(XlChartType.xlColumnClustered) ‘차트 종류의 이름
Set ch = sh.Chart
‘차트 요소 생성
With ch
.SetSourceData rs ‘차트 원본범위
.HasTitle = True ‘차트 제목 설정
.ChartTitle.Text = “제품별 판매수량” ‘차트 제목 입력
.HasLegend = False ‘범례 해제
End With
‘차트 이름, 위치, 크기
With sh
Set rd = ws.Range(“f1:j10”) ‘차트가 들어갈 범위를 설정
.Name = “cht1” ‘차트 이름
.Top = rd.Top ‘차트 위치
.Left = rd.Left ‘차트 위치
.Width = rd.Width ‘차트 사이즈
.Height = rd.Height ‘차트 사이즈
End With
<13-2 분산형차트에 레이블 추가 및 마커 변경>
Dim rng As Range, rd As Range
Dim sh As Shape
Dim ch As Chart
Dim ser As Series
Dim i As Integer, j As Integer
Dim c As Range, lbl As Range
Set rng = Sheet1.Range(“b2”, Sheet1.Cells(Rows.Count, “c”).End(3))
On Error Resume Next
Sheet1.ChartObjects.Delete
On Error GoTo 0
‘차트 생성
Set sh = Sheet1.Shapes.AddChart2(, xlXYScatter)
Set ch = sh.Chart
‘차트 요소 생성
With ch
.SetSourceData rng
.HasTitle = True
.ChartTitle.Text = “제품별 사이즈 측정”
.HasLegend = False
End With
‘차트 이름, 위치, 크기
With sh
Set rd = Sheet1.Range(“e1:j11”)
.Name = “cht1”
.Top = rd.Top
.Left = rd.Left
.Width = rd.Width
.Height = rd.Height
End With
‘레이블 추가
Set ser = Sheet1.ChartObjects(1).Chart.SeriesCollection(1)
Set lbl = Sheet1.Range(“a2”, Sheet1.Range(“a2”).End(xlDown))
ser.HasDataLabels = True
For Each c In lbl
i = i + 1
ser.Points(i).DataLabel.Text = c.Value
Next
‘일정한 조건 갖추면 색상 변경
Dim Yvals, Xvals
Yvals = ser.Values
Xvals = ser.XValues
For i = LBound(Yvals) To UBound(Yvals)
If Yvals(i) >= 170 And Xvals(i) >= 65 Then
With ser.Points(i)
.MarkerBackgroundColor = RGB(255, 0, 0)
.MarkerStyle = -4168
End With
End If
Next
<13-3 차트 삭제>
Dim sh As Worksheet ‘단일 시트의 모든 차트 삭제
Set sh = Sheet1
If sh.ChartObjects.Count Then sh.ChartObjects.Delete
Dim sh As Worksheet ‘모든 시트의 모든 차트 삭제
For Each sh In ThisWorkbook.Worksheets
If sh.ChartObjects.Count Then
sh.ChartObjects.Delete
End If
Next
<15-1 특정 경로의 텍스트 파일 가져오기>
Dim c As Range
Dim FilePath As String
Dim data As String
Dim i As Integer
Dim arr
Set c = Sheet1.Range(“a1”)
c.CurrentRegion.Clear
FilePath = Environ(“userprofile”) & “DesktopVBA_109학자금상환현황.txt”
Open FilePath For Input As #1
Do Until EOF(1)
Line Input #1, data
arr = Split(data, “,”)
c.Offset(i).Resize(1, UBound(arr) + 1) = arr
i = i + 1
Loop
Close #1
c.CurrentRegion.Columns.AutoFit
<15-2 폴더 내, 모든 텍스트 파일 가져오기>
Dim c As Range, FilePath As String, FileName As String
Dim data As String
Dim i As Integer, FileNum As Integer
Dim arr
Sheet1.Cells.Clear
Set c = Sheet1.Range(“a1”)
‘폴더 선택 & 경로
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
FilePath = .SelectedItems(1) & “”
End If
End With
‘폴더 내,텍스트 파일 존재 여부
FileName = Dir(FilePath & “*.txt”)
If FileName = “” Then
MsgBox “폴더 내, 텍스트 파일이 없습니다”
Exit Sub
End If
Do While FileName <> “”
FileNum = FreeFile
Open FilePath & FileName For Input As #FileNum
Do Until EOF(FileNum)
Line Input #FileNum, data
arr = Split(data, “,”)
If arr(0) <> “구분1” Then
c.Offset(i).Resize(1, UBound(arr) + 1) = arr
i = i + 1
End If
Loop
Close #FileNum
FileName = Dir
Loop
c.CurrentRegion.Columns.AutoFit
<16 위, 아래 데이터가 같은지 다른지 비교해서 작업하기>
For Each c In rng
If c.Value = c.Offset(1).Value Then
i = i + 1
Else
If i = 0 Then ‘같지 않으면
‘To do
Else ‘같으면
‘To do
End If
i = 0
End If
Next
<17 특정 색상이 칠해진 여러 셀 선택하기>
Dim rng As Range, cf As Range, uni As Range
Dim adr As String
Application.FindFormat.Clear
Application.FindFormat.Interior.ColorIndex = 6
Set rng = Columns(“a”).SpecialCells(2)
Set cf = rng.Find(“*”, searchformat:=True)
If cf Is Nothing = 0 Then
adr = cf.Address
Do
If uni Is Nothing Then
Set uni = cf
Else
Set uni = Union(uni, cf)
End If
Set cf = rng.Find(“*”, after:=cf, searchformat:=True)
Loop While cf.Address <> adr
End If
If uni Is Nothing = 0 Then uni.Select
Application.FindFormat.Clear
<18 프로시저 처리 속도 확인>
Dim sT As Date, eT As Date
sT = Timer
‘실행 코드
eT = Timer
MsgBox Format(eT – sT, “0000.00000”) & “초”
<19-1 숫자를 반환할 때>
Dim MyRow As Long
Application.DisplayAlerts = False
On Error Resume Next
MyRow = Application.InputBox(“작업할 행을 입력하세요”, Type:=1)
If err Then Exit Sub
‘To do
Application.DisplayAlerts = True
<19-2 셀주소를 반환할 때>
Dim MyRng As Range
Application.DisplayAlerts = False
On Error Resume Next
TA:
Set MyRng = Application.InputBox(“셀범위를 드래그하세요”, Type:=8)
If err Then Exit Sub
If MyRng.Count = 1 Then
MsgBox “2개 이상의 셀을 선택해야 합니다”
GoTo TA
End If
‘To do
On Error GoTo 0
Application.DisplayAlerts = True
<20 시트 보호되어 있는 시트에서 매크로 작업 가능하도록 하기>
Sub 메인프로시저()
Dim sh As Worksheet
Set sh = Sheet1
Call fnUnProtect(sh)
‘To do
Call fnProtect(sh)
End Sub
Sub fnProtect(sh As Worksheet)
sh.Protect Password:=”1234567″, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End Sub
Sub fnUnProtect(sh As Worksheet)
sh.Unprotect “1234567”
End Sub
<56 셀에 하이퍼링크걸기 ; 정리GBS>
Sub 하이퍼링크걸기()
Dim rng As Range, c As Range
Set rng = Range(“b2:b15”)
For Each c In rng
If Not c.Hyperlinks.Count > 0 Then
c.Hyperlinks.Add anchor:=c, Address:=c.Value
End If
Next
End Sub
노트-정리
노트-정리1
VBAVBA 비밀노트
엑셀디자인
—————————————————–Page 1—————————————————–
목차
01 셀 , 범위 선택하는 방법 ……………………………………………………………………………………………………………. 5
01-1 셀 선택 기본 [ 엑셀디자인 VBA 2] …………………………………………………………………………………………… 5
01-2 범위 선택 [ 엑셀디자인 VBA 3~7] …………………………………………………………………………………………… 5
01-3 셀 이동 [ 엑셀디자인 VBA 3~7] ………………………………………………………………………………………………. 6
01-4 범위 재조정 ★★ [엑셀디자인 VBA 3~7] …………………………………………………………………………………. 6
01-5 마지막 셀 [ 엑셀디자인 VBA 3~7] ……………………………………………………………………………………………. 6
01-6 기타 [ 엑셀디자인 VBA 3~7] ……………………………………………………………………………………………………. 7
01-7 행 / 열에서 특정 값과 다른 모든 셀 가져오기 ……………………………………………………………………………. 7
01-8 합집합 ★★★ [엑셀디자인 VBA 8] ……………………………………………………………………………………………. 8
01-9 교집합 ★★★ [엑셀디자인 VBA 14] ………………………………………………………………………………………….. 8
01-10 빈 셀 또는 값이 입력된 셀만 선택 ★★★ [엑셀디자인 VBA 9] ……………………………………………………. 9
02 행 삽입과 삭제 …………………………………………………………………………………………………………………………… 10
02-1 행 삽입 기본 [ 엑셀디자인 VBA 36] ……………………………………………………………………………………………. 10
02-2 행 삽입 개선 ( 정렬 기능 활용 ) [ 엑셀디자인 VBA 38] …………………………………………………………………. 10
02-3 행 삭제 기본 1 [ 엑셀디자인 VBA 39] ………………………………………………………………………………………….. 11
02-4 행 삭제 기본 2(Areas 속성 활용 ) ……………………………………………………………………………………………….. 11
02-5 행 삭제 개선 1(Union 메서드 활용) ★★★ [엑셀디자인 VBA 40] ………………………………………………….. 12
02-6 행 삭제 개선 2( 배열 활용) ★★ [엑셀디자인 VBA 41] ………………………………………………………………….. 12
03 셀 병합과 해제 …………………………………………………………………………………………………………………………….. 14
03-1 셀 병합 기본 1 …………………………………………………………………………………………………………………………… 14
03-2 셀 병합 기본 2 …………………………………………………………………………………………………………………………… 14
03-3 병합셀 복사 , 붙여넣기 ………………………………………………………………………………………………………………. 14
03-4 셀 병합 해제 ★★ [엑셀디자인 VBA 16] ………………………………………………………………………………………. 15
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 2—————————————————–
04 실무에서 유용한 배열의 다양한 접근 방법 …………………………………………………………………………………….. 16
04-1 특정 영역의 데이터를 다른 영역에 한방에 뿌리기 …………………………………………………………… 16
04-2 특정 영역의 데이터를 계산 후 다른 영역에 한방에 뿌리기 …………………………………………… 16
04-3 조건을 만족하는 데이터만 배열에 담아 한방에 뿌리기 ★★ ………………………………………… 17
04-4 특정 시트 한방에 삭제하기 [ 엑셀디자인 VBA 24] …………………………………………………………….. 18
04-5 문자 합치기 ★ ……………………………………………………………………………………………………………………………. 19
04-6 문자 나누기 ★★★ [ 엑셀디자인 VBA 29] ……………………………………………………………………………. 19
05 배열 vs. 컬렉션 ……………………………………………………………………………………………………………………………………….. 21
05-1 컬렉션 개체로 특정 영역의 데이터 한방에 담기 ★ ………………………………………………………… 21
05-2 컬렉션 개체로 조건에 맞는 데이터만 한방에 담기 ★ …………………………………………………….. 21
05-3 컬렉션 개체로 중복되지 않은 고유한 항목만 담기 [ 엑셀디자인 VBA 26] ………………….. 22
05-4 컬렉션 개체의 단점 ……………………………………………………………………………………………………………………. 22
06 Dir 함수로 파일과 폴더 핸들링 …………………………………………………………………………………………………………… 24
06-1 특정 파일의 존재 여부 확인 …………………………………………………………………………………………………… 24
06-2 특정 폴더의 존재 여부 확인 …………………………………………………………………………………………………… 24
06-3 특정 폴더의 존재 여부를 확인해서 없으면 만들기 …………………………………………………………… 25
06-4 특정 폴더 내 , 모든 폴더 및 파일 이름 가져오기 ……………………………………………………………… 25
06-5 특정 폴더 내 , 모든 폴더의 이름 가져오기 ………………………………………………………………………….. 26
06-6 특정 폴더 내 , 모든 파일의 이름 가져오기 ………………………………………………………………………….. 26
06-7 특정 폴더 내 , 첫번째 엑셀 파일의 이름 가져오기 ……………………………………………………………. 27
06-8 특정 폴더 내 , 모든 엑셀 파일의 이름 가져오기 ★ ………………………………………………………….. 27
06-9 특정 폴더 내 , 모든 엑셀 파일 통합하기 ★★★ [엑셀디자인 VBA 93] ……………………….. 27
06-10 특정 파일만 자동으로 가져와서 작업하기 ★★★ ………………………………………………………….. 28
06-11 특정 폴더를 유저가 선택해서 파일 통합하기 ★★★ ……………………………………………………. 30
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 3—————————————————–
06-12 특정한 파일을 유저가 선택해서 작업하기 ★ …………………………………………………………………… 31
06-13 워크시트를 새 파일로 생성하기 ★★★ …………………………………………………………………………….. 32
06-14 모든 워크시트를 각각의 새 파일로 생성하기 ★★★ ……………………………………………………. 32
07 Like 연산자 패턴들 ★ [엑셀디자인 VBA 18~20] ……………………………………………………………………………. 34
08 시트 통합 ★★★ [엑셀디자인 VBA 88] ……………………………………………………………………………………………. 34
09 정렬 ………………………………………………………………………………………………………………………………………………. 35
09-1 정렬 기본 ★ [엑셀디자인 VBA 30~31] ………………………………………………………………………………… 35
09-2 여러 필드 정렬 (3 개까지만 ) ……………………………………………………………………………………………………… 35
09-3 여러 필드 정렬 (3 개 이상~) ★ ……………………………………………………………………………………………….. 35
10 필터 ………………………………………………………………………………………………………………………………………….. 37
10-1 자동 필터 ★★ [엑셀디자인 VBA 32~33] …………………………………………………………………………….. 37
10-2 고급 필터 ★★ [엑셀디자인 VBA 35] ……………………………………………………………………………………. 37
11 Find 로 특정 문자 찾기 …………………………………………………………………………………………………………………………. 38
11-1 Find 기본 ( 찾아야 할 셀이 하나일 때) ★★★ [엑셀디자인 VBA 42] ……………………………… 38
11-2 Find 응용 ( 찾아야 할 셀이 여러 개일 때) ★★★ [엑셀디자인 VBA 43~45] ………………… 38
12 데이터집계를 위한 피벗 생성 ……………………………………………………………………………………………………………… 39
12-1 피벗 생성 기본 ★★★ [엑셀디자인 VBA 53] ……………………………………………………………………… 39
12-2 피벗 생성 기본 Plus ★★ [엑셀디자인 VBA 54] ………………………………………………………………… 40
12-3 피벗의 다양한 범위 참조 ★★ ……………………………………………………………………………………………….. 40
12-4 피벗 슬라이서 생성과 위치 지정 ★ [엑셀디자인 VBA 56] …………………………………………….. 43
13 차트 …………………………………………………………………………………………………………………………………………… 45
13-1 차트 생성 기본 ★★★ [엑셀디자인 VBA 62] ……………………………………………………………………… 45
13-2 분산형 차트에 레이블 추가 및 마커 변경 ★ [엑셀디자인 VBA 89] …………………………….. 46
13-3 차트 삭제 ★★ ……………………………………………………………………………………………………………………………. 48
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 4—————————————————–
14 클래스 모듈 코딩 순서 (feat. 차트 ) [ 엑셀디자인 VBA 104~108] …………………………………………………. 48
15 텍스트 파일 핸들링 ……………………………………………………………………………………………………………………………….. 49
15-1 특정 경로의 텍스트 파일 가져오기 [ 엑셀디자인 VBA 109] ……………………………………………. 49
15-2 폴더 내 , 모든 텍스트 파일 가져오기 [ 엑셀디자인 VBA 110] …………………………………………. 50
16 위 , 아래 데이터가 같은지 다른지 비교해서 작업하기 ★★ ……………………………………………………….. 51
17 특정 색상이 칠해진 여러 셀 선택하기 [ 엑셀디자인 VBA 115] ………………………………………………….. 52
18 프로시저 처리 속도 확인 ★★★ ……………………………………………………………………………………………………….. 53
19 Application.InputBox 메서드 에러 처리 ……………………………………………………………………………………………. 53
19-1 숫자를 반환할 때 ★ …………………………………………………………………………………………………………………. 53
19-2 셀주소를 반환할 때 ★ ……………………………………………………………………………………………………………… 54
20 시트 보호되어 있는 시트에서 매크로 작업 가능하도록 하기 ……………………………………………………. 54
21 시트의 그림 모두 지우기 ……………………………………………………………………………………………………………………… 55
22 시트를 복사 또는 이동 시 , objects 는 제외시키기 ………………………………………………………………………… 55
23 통합문서 내 , 모든 이름정의 삭제 ………………………………………………………………………………………………………. 55
24 Type 판별 ………………………………………………………………………………………………………………………………………………….. 55
25 버튼 캡션을 셀에 입력하기 …………………………………………………………………………………………………………………. 56
26 하이퍼링크 걸기 ……………………………………………………………………………………………………………………………………… 56
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
노트-정리2
VBA 비밀노트/엑셀디자인
—————————————————–Page 1—————————————————–1
목차
01 셀 , 범위 선택하는 방법 ………………………………………………………………………………………………………………………….. 5
01-1 셀 선택 기본 [ 엑셀디자인 VBA 2] …………………………………………………………………………………………… 5
01-2 범위 선택 [ 엑셀디자인 VBA 3~7] ……………………………………………………………………………………………. 5
01-3 셀 이동 [ 엑셀디자인 VBA 3~7] ………………………………………………………………………………………………… 6
01-4 범위 재조정 ★★ [엑셀디자인 VBA 3~7] ………………………………………………………………………………. 6
01-5 마지막 셀 [ 엑셀디자인 VBA 3~7] ……………………………………………………………………………………………. 6
01-6 기타 [ 엑셀디자인 VBA 3~7] ………………………………………………………………………………………………………. 7
01-7 행 / 열에서 특정 값과 다른 모든 셀 가져오기 ……………………………………………………………………….. 7
01-8 합집합 ★★★ [엑셀디자인 VBA 8] ………………………………………………………………………………………….. 8
01-9 교집합 ★★★ [엑셀디자인 VBA 14] ……………………………………………………………………………………….. 8
01-10 빈 셀 또는 값이 입력된 셀만 선택 ★★★ [엑셀디자인 VBA 9] …………………………………… 9
02 행 삽입과 삭제 ……………………………………………………………………………………………………………………………………….. 10
02-1 행 삽입 기본 [ 엑셀디자인 VBA 36] ……………………………………………………………………………………….. 10
02-2 행 삽입 개선 ( 정렬 기능 활용 ) [ 엑셀디자인 VBA 38] …………………………………………………………. 10
02-3 행 삭제 기본 1 [ 엑셀디자인 VBA 39] …………………………………………………………………………………….. 11
02-4 행 삭제 기본 2(Areas 속성 활용 ) …………………………………………………………………………………………… 11
02-5 행 삭제 개선 1(Union 메서드 활용) ★★★ [엑셀디자인 VBA 40] …………………………………. 12
02-6 행 삭제 개선 2( 배열 활용) ★★ [엑셀디자인 VBA 41] ………………………………………………………. 12
03 셀 병합과 해제 ……………………………………………………………………………………………………………………………………….. 14
03-1 셀 병합 기본 1 …………………………………………………………………………………………………………………………….. 14
03-2 셀 병합 기본 2 …………………………………………………………………………………………………………………………….. 14
03-3 병합셀 복사 , 붙여넣기 ………………………………………………………………………………………………………………. 14
03-4 셀 병합 해제 ★★ [엑셀디자인 VBA 16] ……………………………………………………………………………… 15
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 2—————————————————–2
04 실무에서 유용한 배열의 다양한 접근 방법 …………………………………………………………………………………….. 16
04-1 특정 영역의 데이터를 다른 영역에 한방에 뿌리기 …………………………………………………………… 16
04-2 특정 영역의 데이터를 계산 후 다른 영역에 한방에 뿌리기 …………………………………………… 16
04-3 조건을 만족하는 데이터만 배열에 담아 한방에 뿌리기 ★★ ………………………………………… 17
04-4 특정 시트 한방에 삭제하기 [ 엑셀디자인 VBA 24] …………………………………………………………….. 18
04-5 문자 합치기 ★ ……………………………………………………………………………………………………………………………. 19
04-6 문자 나누기 ★★★ [ 엑셀디자인 VBA 29] ……………………………………………………………………………. 19
05 배열 vs. 컬렉션 ……………………………………………………………………………………………………………………………………….. 21
05-1 컬렉션 개체로 특정 영역의 데이터 한방에 담기 ★ ………………………………………………………… 21
05-2 컬렉션 개체로 조건에 맞는 데이터만 한방에 담기 ★ …………………………………………………….. 21
05-3 컬렉션 개체로 중복되지 않은 고유한 항목만 담기 [ 엑셀디자인 VBA 26] ………………….. 22
05-4 컬렉션 개체의 단점 ……………………………………………………………………………………………………………………. 22
06 Dir 함수로 파일과 폴더 핸들링 …………………………………………………………………………………………………………… 24
06-1 특정 파일의 존재 여부 확인 …………………………………………………………………………………………………… 24
06-2 특정 폴더의 존재 여부 확인 …………………………………………………………………………………………………… 24
06-3 특정 폴더의 존재 여부를 확인해서 없으면 만들기 …………………………………………………………… 25
06-4 특정 폴더 내 , 모든 폴더 및 파일 이름 가져오기 ……………………………………………………………… 25
06-5 특정 폴더 내 , 모든 폴더의 이름 가져오기 ………………………………………………………………………….. 26
06-6 특정 폴더 내 , 모든 파일의 이름 가져오기 ………………………………………………………………………….. 26
06-7 특정 폴더 내 , 첫번째 엑셀 파일의 이름 가져오기 ……………………………………………………………. 27
06-8 특정 폴더 내 , 모든 엑셀 파일의 이름 가져오기 ★ ………………………………………………………….. 27
06-9 특정 폴더 내 , 모든 엑셀 파일 통합하기 ★★★ [엑셀디자인 VBA 93] ……………………….. 27
06-10 특정 파일만 자동으로 가져와서 작업하기 ★★★ ………………………………………………………….. 28
06-11 특정 폴더를 유저가 선택해서 파일 통합하기 ★★★ ……………………………………………………. 30
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 3—————————————————–3
06-12 특정한 파일을 유저가 선택해서 작업하기 ★ …………………………………………………………………… 31
06-13 워크시트를 새 파일로 생성하기 ★★★ …………………………………………………………………………….. 32
06-14 모든 워크시트를 각각의 새 파일로 생성하기 ★★★ ……………………………………………………. 32
07 Like 연산자 패턴들 ★ [엑셀디자인 VBA 18~20] ……………………………………………………………………………. 34
08 시트 통합 ★★★ [엑셀디자인 VBA 88] ……………………………………………………………………………………………. 34
09 정렬 ……………………………………………………………………………………………………………………………………………………………. 35
09-1 정렬 기본 ★ [엑셀디자인 VBA 30~31] ………………………………………………………………………………… 35
09-2 여러 필드 정렬 (3 개까지만 ) ……………………………………………………………………………………………………… 35
09-3 여러 필드 정렬 (3 개 이상~) ★ ……………………………………………………………………………………………….. 35
10 필터 ……………………………………………………………………………………………………………………………………………………………. 37
10-1 자동 필터 ★★ [엑셀디자인 VBA 32~33] …………………………………………………………………………….. 37
10-2 고급 필터 ★★ [엑셀디자인 VBA 35] ……………………………………………………………………………………. 37
11 Find 로 특정 문자 찾기 …………………………………………………………………………………………………………………………. 38
11-1 Find 기본 ( 찾아야 할 셀이 하나일 때) ★★★ [엑셀디자인 VBA 42] ……………………………… 38
11-2 Find 응용 ( 찾아야 할 셀이 여러 개일 때) ★★★ [엑셀디자인 VBA 43~45] ………………… 38
12 데이터집계를 위한 피벗 생성 ……………………………………………………………………………………………………………… 39
12-1 피벗 생성 기본 ★★★ [엑셀디자인 VBA 53] ……………………………………………………………………… 39
12-2 피벗 생성 기본 Plus ★★ [엑셀디자인 VBA 54] ………………………………………………………………… 40
12-3 피벗의 다양한 범위 참조 ★★ ……………………………………………………………………………………………….. 40
12-4 피벗 슬라이서 생성과 위치 지정 ★ [엑셀디자인 VBA 56] …………………………………………….. 43
13 차트 ……………………………………………………………………………………………………………………………………………………………. 45
13-1 차트 생성 기본 ★★★ [엑셀디자인 VBA 62] ……………………………………………………………………… 45
13-2 분산형 차트에 레이블 추가 및 마커 변경 ★ [엑셀디자인 VBA 89] …………………………….. 46
13-3 차트 삭제 ★★ ……………………………………………………………………………………………………………………………. 48
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 4—————————————————–4
14 클래스 모듈 코딩 순서 (feat. 차트 ) [ 엑셀디자인 VBA 104~108] …………………………………………………. 48
15 텍스트 파일 핸들링 ……………………………………………………………………………………………………………………………….. 49
15-1 특정 경로의 텍스트 파일 가져오기 [ 엑셀디자인 VBA 109] ……………………………………………. 49
15-2 폴더 내 , 모든 텍스트 파일 가져오기 [ 엑셀디자인 VBA 110] …………………………………………. 50
16 위 , 아래 데이터가 같은지 다른지 비교해서 작업하기 ★★ ……………………………………………………….. 51
17 특정 색상이 칠해진 여러 셀 선택하기 [ 엑셀디자인 VBA 115] ………………………………………………….. 52
18 프로시저 처리 속도 확인 ★★★ ……………………………………………………………………………………………………….. 53
19 Application.InputBox 메서드 에러 처리 ……………………………………………………………………………………………. 53
19-1 숫자를 반환할 때 ★ …………………………………………………………………………………………………………………. 53
19-2 셀주소를 반환할 때 ★ ……………………………………………………………………………………………………………… 54
20 시트 보호되어 있는 시트에서 매크로 작업 가능하도록 하기 ……………………………………………………. 54
21 시트의 그림 모두 지우기 ……………………………………………………………………………………………………………………… 55
22 시트를 복사 또는 이동 시 , objects 는 제외시키기 ………………………………………………………………………… 55
23 통합문서 내 , 모든 이름정의 삭제 ………………………………………………………………………………………………………. 55
24 Type 판별 ………………………………………………………………………………………………………………………………………………….. 55
25 버튼 캡션을 셀에 입력하기 …………………………………………………………………………………………………………………. 56
26 하이퍼링크 걸기 ……………………………………………………………………………………………………………………………………… 56
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 5—————————————————–5
01 셀 , 범위 선택하는 방법
01-1 셀 선택 기본 [ 엑셀디자인 VBA 2]
1 R ange(“a1”) : 이 프로시저가 입력되고 있는 워크북 , 활성화된 시트의 A1 셀 2 Cells(1,1) : 이 프로시저가 입력되고 있는 워크북 , 활성화된 시트의 1 행 , 1 열의 셀 3 C ells(1,”a”) : 이 프로시저가 입력되고 있는 워크북 , 활성화된 시트의 1 행 , A 열의 셀 4 Sheets(“test”).Range(“a1”) : test 시트의 A1 셀 5 S heets(1).Range(“a1”) : 첫번째 시트의 A1 셀 6 Sheet1.Range(“a1”) : Sheet1 의 A1 셀
7 wb.Sheet1.Range(“a1”) : wb 변수에 들어온 워크북 , Sheet1 의 A1 셀
1~3 : 셀 선택 코드는 위험요소가 있다 . range 개체 앞에 부모 개체가 없기 때문이다 . 4 : 시트의 이름이 바뀌면 에러가 발생한다 .
5 : 유저가 시트의 순서를 바꾸면 엉뚱한 시트에서 데이터를 가져오는 문제가 발생한다 . 6 : 제일 안전하다 . 시트명을 바꿔도 , 시트 순서를 바꿔도 문제없다 .
7 : 워크북 여러 개를 왔다 갔다 하면서 작업할 시 , 변수에 (wb) 워크북을 받아서 사용한다 . 그러면 앞으로 6 번 코드만 사용하겠다 ?
아니다 . 실무에서는 데이터 형태 , 가공 방법이 다양하므로 케바케로 위의 코드 모두 정확하게 이해하고 사용할 수 있어야 한다 .
01-2 범위 선택 [ 엑셀디자인 VBA 3~7]
1 Range(“a2”, Cells(Rows.Count, “a”).End(xlUp) ) ★★★
현재 활성화되어 있는 시트 , A2 셀부터 A 열의 데이터가 있는 마지막 셀까지 줄여서 오른쪽 처럼 쓸 수 있다 . Range(“a2”, Cells(Rows.Count, “a”).End(3)) 2. sh.Range(sh.Range(“a2”), sh.Cells(Rows.Count, “a”).End(xlUp))
sh 변수로 받은 시트의 A2 셀부터 A 열의 데이터가 있는 마지막 셀까지
1 : 마지막 줄 코드처럼 가능한한 코드를 짧게 쓰도록 노력하자 .
2 : 1 번보다 실무에서 더 많이 쓰는 유형이다 . 시트를 왔다 갔다 하면서 작업하는 케이스 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 6—————————————————–6
01-3 셀 이동 [ 엑셀디자인 VBA 3~7]
1 R ange(“a2”).Offset(1,0) : A2 셀에서 아래로 1 행 , 오른쪽으로 0 열 이동한 A3 셀 2 Range(“a2”).Offset(1) : 1 번 코드와 동일한 의미 , 0 은 생략 가능
3 Range(“a2”).Offset( -1,2) : A2 셀에서 위로 1 행 , 오른쪽으로 2 열 이동한 C1 셀 4 Cells(Rows.Count, “a”).End(xlUp).Offset(1)
4 번 코드는 실무에서 사용빈도가 대단히 높다 . 외우자 A 열의 데이터가 있는 마지막 셀에서 아래로 1 행 이동한 셀 보통 데이터를 누적해서 아래로 아래로 쌓아 내려갈 때 사용한다 . 줄여서 오른쪽 처럼 쓸 수 있다 . Cells(Rows.Count, “a”).End(3)(2) ★★★
01-4 범위 재조정 ★★ [ 엑셀디자인 VBA 3~7]
1 특정영역 .Resize( 행 , 열 ) : 특정영역내에서 행 , 열 만큼 영역을 재설정 2 Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
Set rng = rng.Offset(1).Resize(rng.Rows.Count – 1) rng.Select
실무에서 Resize 는 Offset 과 보통 같이 쓰는 경우가 대부분이다 .
왜 rng 를 두 번 생성했는가 ? 첫번째 rng 는 A1 셀을 기준으로 연속된 범위를 몽땅 다 잡는 코드로 , 이렇게 잡으면 1 행의 제목 필드까지 다 잡힌다 . 그래서 두번째 rng 에서 기존 rng 영역에서 1 행 내려와서 , 다시 영역을 재설정하여 본문 데이터만 rng 영역으로 잡히도록 코딩한다 .
이상하다 . Resize(rng.Rows.Count – 1) 이 부분을 보면 행인수가 들어가는 자리에만 코드가 있고 열인수가 들어가는 자리는 생략되어 있다 . 무슨 의미인가 ? 기존 rng 영역의 열개수를 그대로 사용하겠다 .. 라는 의미이다 . 왜 이렇게 쓰는가 ? 짧게 쓰는 게 좋으니까 !
01-5 마지막 셀 [ 엑셀디자인 VBA 3~7]
1 Range(“b5”).End(xlToLeft) / Range(“b5”).End(1) 2 Range(“b5”).End(xlToRight) / Range(“b5”).End(2) 3 Range(“b5”).End(xlUp) / Range(“b5”).End(3 ) 4 range(“b5”).End(xlDown) / Range(“b5”).End(4)
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 7—————————————————–7
1~4 : B5 셀을 기준으로 상하좌우 방향으로 데이터가 있는 마지막 셀을 말한다 . 슬래시 (/) 뒤쪽의 코드가 같은 의미의 코드이다 . 코드가 짧아서 실무에서 더 유용하다 .
01-6 기타 [ 엑셀디자인 VBA 3~7]
1 Range(“a1”).CurrentRegion : A1 셀을 기준으로 연속된 범위 ★★★
2 Sheet1.UsedRange : Sheet 에서 사용되어진 범위
3 Sheet2.Cells.Clear : Sheet2 의 모든 셀들의 문자 , 서식들을 지움 ★★
4 Range(“a1”).EntireColumn : A1 셀이 있는 전체 열
5 Range(“a1”).EntireColumn.AutoFit : A1 셀이 있는 전체 열을 자동 열맞춤 해라 6 Range(“a1”).EntireRow : A1 셀이 있는 전체 행
3 : 특정 시트에 데이터를 뿌리기 전 , 기존 시트를 깨끗하게 청소하는 용도로 실무에서 사용한다 . 5 : 보통 실무에서 데이터 처리 , 가공이 모두 끝난 후 , 마지막에 열너비를 조정하기 위해 쓴다 .
01-7 행 / 열에서 특정 값과 다른 모든 셀 가져오기
1 Dim rng As Range, rngS As Range, rngT As Range
Set rng = Columns(“a”).SpecialCells(2) ‘ A 열 데이터가 있는 영역 Set rngS = Range(“a1”)
Set rngT = rng.ColumnDifferences(rngS) rngT.Select
rng 영역에서 A1 셀의 값과 다른 값들만 rngT 영역으로 모아 한방에 선택
2. Dim rng As Range, rngS As Range, rngT As Range
Set rng = Rows(12).SpecialCells(2) Set rngS = Range(“a12”)
Set rngT = rng.RowDifferences(rngS) rngT.Select
rng 영역에서 A12 셀의 값과 다른 값들만 rngT 영역으로 모아 한방에 선택
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 8—————————————————–8
ColumnDifferences, RowDifferences 는 참으로 유용한 메서드이다 .
ColumnDifferences 는 열방향으로 , RowDifferences 는 행방향으로 특정값과 다른 셀들을 한방에 Range 개체로 반환해준다 . 실무에서 데이터가 많다면 반복문과 조건문을 써서 코딩하는 것보다 처리속도가 현저하게 빨라진다 .
01-8 합집합 ★★★ [ 엑셀디자인 VBA 8]
1 Union( 범위 1, 범위 2 , …. , 범위 30) : 둘 이상의 범위의 합집합 2 Dim c As Range, uni As Range
For Each c In Range(“a1:a10”)
If c = 4 Or c = 6 Then ‘셀의 값이 4 또는 6 이면 무시해라 Else ‘4 또는 6 이 아니면 아래 코드 실행 If uni Is Nothing Then ‘처음에는 uni 변수에 아무것도 없으므로 Set uni = c ‘ uni 변수에 c 변수에 들어온 값을 넣고 Else ‘두번째 부터는 uni 변수에 값이 들어오므로
Set uni = Union(uni, c) ‘기존 uni 변수에 보관된 셀과 새로운 c 변수의 값을 합함
End If End If
Next
If uni Is Nothing = 0 Then uni.Select ‘uni 변수에 보관된 셀이 있으면 선택해라
1 : Union 메서드의 기본 구문
2 : 실무에서 주로 쓰이는 패턴 코드이다 . 특히 파란색으로 쓰여진 부분은 Union 메서드가 들어가는 코드에서는 늘 쓰이므로 외우자 .
01-9 교집합 ★★★ [ 엑셀디자인 VBA 14]
1 Intersect( 범위 1, 범위 2 , …. , 범위 30) : 둘 이상의 범위의 교집합 2 Dim isect as Range, rng1 as Range, rng2 as Range
Set rng1 = range(“a1:d10”) Set rng2 = Range(“c5:g20”)
Set isect = Intersect(r ng1, rng2) ‘rng1, rng2 영역에서 교집합을 isect 변수에 넣음 If isect Is Nothing Then ‘ 교집합이 없으면
MsgBox ” 교집합이 없습니다 “
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 9—————————————————–9
Else ‘ 교집합이 있으면
isect.Select
End If
3 Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(“b”)) Is Nothing Then ‘ B 열에 값이 바뀌면 Application.EnableEvents = False ‘실행문을 한번만 실행
‘To do
Application.EnableEvents = True ‘다시 이벤트 동작을 활성화
End If
End Sub
1 : Intersect 메서드의 기본 구문 3 : Intersect 패턴 코드 .
Intersect 메서드는 실무에서 이벤트 프로시저에서 주로 사용된다 . 특정 열에서 값이 입력되거나 삭제되는 Change 이벤트가 발생 시 , 특정 명령을 실행하고자 할 때 Intersect 메서드가 늘 쓰이므로 파란색 코드 부분을 외우자 .
‘If Target.Cells.Count > 1 Then Exit Sub’ 는 여러 개의 셀을 블록설정 후 지우면 프로시저를 빠져 나가라 .. 라는 뜻으로 Change 이벤트에서 특정 셀들을 지울 때 발생하는 에러를 처리하기 위한 코드이다 .
01-10 빈 셀 또는 값이 입력된 셀만 선택 ★★★ [ 엑셀디자인 VBA 9]
1 Range.SpecialCells(Type) 2 Dim rng As Range
Set rng = Range(“a1”).CurrentRegion 1 번은 SpeciallCells 메서드의 기본 구문
On Error Resume Next
2 번은 실무에서 너무나 자주 쓰이는 패턴 코드
rng.SpecialCells(xlCellTypeBlanks) = “*” ‘ rng 영역에서 빈 셀에 ‘*’를 입력 rng.SpecialCells(xlCellTypeBlanks) 는 줄여서 rng.SpecialCells(4) 라고 쓴다 .
On Error GoTo 0
또한 자주 쓰이는 코드는 rng.SpecialCells(xlCellTypeConstants) 로서 rng 영역에서 데이터가 있는 셀만 반환해준다 . 줄여서 rng.SpecialCells(2) 라고 쓴다 . 그럼 On Error Resume Next 코드는 왜 썼는가 ? SpecialCells 메서드에서 찾고자 하는 유형이 없으면 에러가 발생하기 때문이다 . 따라서 SpecialCells 메서드를 쓰면 항상 에러처리 코드와 함께 사용해야 한다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 10—————————————————–10
02 행 삽입과 삭제
02-1 행 삽입 기본 [ 엑셀디자인 VBA 36]
Dim lR As Long, i As Long
lR = Cells(Rows.Count, “a”).End(xlUp).Row ‘A 열에서 데이터가 있는 마지막 셀의 행번호
For i = lR To 2 Step -1 ‘마지막 행에서 2 행까지 거꾸로 순환 If i <> lR Then ‘마지막 행에서는 행 삽입 할 필요 없음
Cells(i, “a”).Offset(1).Resize(, 5).Insert
End If
Next
행과 행 사이에 빈 행을 삽입하고자는 하는 기본 코드이다 . 핵심은 아래에서 위 방향으로 행을 삽입하는 것이다 . 하지만 실무에서 데이터가 많다면 처리속도가 떨어진다 .
02-2 행 삽입 개선 ( 정렬 기능 활용 ) [ 엑셀디자인 VBA 38]
Dim irR As Integer, cnt As Integer, Tcnt As Long Dim rng As Range, rngC As Range
irR = 10
‘F5 키를 눌렀을 때 한번만 실행되고 더 이상 실행되지 않도록 조건 줌 Set rngC = Range(“a2”).Offset(1).Resize(irR, 1) If Application.CountBlank(rngC) = irR Then
If Range(“a2”).Offset(irR + 1) <> “” Then Exit Sub
End If
cnt = Range(“a2”, Cells(Rows.Count, “a”).End(xlUp)).Rows.Count Tcnt = (irR + 1) * cnt
Range(“f2”).Resize(cnt) = Application.Evaluate(“row(1:” & cnt & “)”) Range(“f2”).Resize(cnt).Copy Range(“f2”).Resize(Tcnt)
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 11—————————————————–11
Set rng = Range(“a2”, Cells(Rows.Count, “f”).End(xlUp)) rng.Sort rng(2, 6)
Range(“f2”).Resize(Tcnt) = “”
Range(“a2”).Resize(Tcnt, 5).Borders.LineStyle = xlContinuous
엑셀의 정렬 기능을 활용해서 행이 삽입되는 효과를 얻게 되므로 처리속도가 현저하게 빨라진다 . Raw Data 는 A1 셀부터 입력되어 있고 , 1 행은 제목 필드 , 2 행부터 본문 데이터가 입력되어 있는 상황 . 행과 행 사이에 irR 변수에 입력된 숫자 만큼 행이 삽입되도록 설계
02-3 행 삭제 기본 1 [ 엑셀디자인 VBA 39]
Dim i As Long, lR As Long
lR = Cells(Rows.Count, “a”).End(xlUp).Row
For i = lR To 2 Step -1
If Cells(i, “a”) = “A-1” Then ‘A 열의 값이 A-1 인 경우에는 해당 행 삭제
Cells(i, “a”).Resize(, 2).Delete
End If
Next
행 삭제 기본 코드이다 . 행 삽입과 마찬가지로 아래에서 위쪽 방향으로 삭제하는 것이 핵심 .
02-4 행 삭제 기본 2(Areas 속성 활용 )
Dim rng As Range, a As Range
Set rng = Range(“a1”, Cells(Rows.Count, “a”).End(xlUp)) For Each a In rng.SpecialCells(4).Areas
If a.Count > 1 Then
‘a.Resize(a.Count – 1).EntireRow.Delete xlShiftUp a.Resize(a.Count – 1, 4).Delete xlShiftUp
End If
Next
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 12—————————————————–12
Raw Data 에 중간 중간 빈 행들이 불규칙하게 삽입되어 있다 . 한 행만 남겨두고 나머지 빈 행들을 삭제하는 코드이다 . Areas 속성의 특징을 이해해야 한다 .
02-5 행 삭제 개선 1(Union 메서드 활용 ) ★★★ [ 엑셀디자인 VBA 40]
Dim uni As Range
Dim i As Long, lR As Long
lR = Cells(Rows.Count, “a”).End(xlUp).Row For i = 2 To lR
If Cells(i, “a”) = “A-1” Then
If uni Is Nothing Then
Set uni = Cells(i, “a”).Resize(, 2)
Else
Set uni = Union(uni, Cells(i, “a”).Resize(, 2))
End If End If
Next
If Not uni Is Nothing Then uni.Delete
A 열 각 셀별로 값이 ‘A – 1’ 이면 uni 변수에 해당 영역을 모았다가 루틴을 빠져 나와서 한방에 삭제하는 코드이다 . 한 셀씩 판단 , 삭제하는 코드 보다 처리속도가 빠르다 .
02-6 행 삭제 개선 2( 배열 활용 ) ★★ [ 엑셀디자인 VBA 41]
Dim r, Dim a()
Dim i As Long, j As Long, k As Long
r = Range(“a1”, Cells(Rows.Count, “b”).End(xlUp)) ‘raw dat a 를 몽땅 r 변수에 넣음 For i = 1 To UBound(r, 1)
If Cells(i, “a”) <> “A-1” Then ‘A -1 이 아니면 배열에 넣음
k=k+1
ReDim Preserve a(1 To 2, 1 To k) ‘기존 배열을 유지하면서
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 13—————————————————–13
For r = 1 To 2
a(r, k) = Cells(i, “a”).Offset(0, r – 1).Value
Next
End If
Next
Range(“a1”).CurrentRegion.ClearContents ‘기존 데이터를 모두 삭제 Range(“a1”).Resize(UBound(a, 2), 2) = Application.Transpose(a) ‘배열 값을 뿌리기
조건에 맞는 데이터만 가져올 때 배열을 쓰면 어떤 유익이 있는가 ?
처리속도가 현저히 현저히 빨라진다 . 배열은 데이터들을 메모리 영역에 넣었다가 한꺼번에 가져올 수 있으므로 처리속도가 빠른 것이다 . 배열을 쓰지 않는다면 , 반복문을 통해 range 개체를 하나 하나 vba 가 계속해서 참조를 해야 하므로 처리속도가 떨어진다 . 따라서 vba 코딩 시 , 처리속도를 중점적으로 생각해야 한다면 가능한 메모리에서 작업이 이루어지도록 변수 , 배열을 적극적으로 활용해야 한다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 14—————————————————–14
03 셀 병합과 해제
03-1 셀 병합 기본 1
MsgBox ActiveCell.MergeCells ‘활성셀이 병합셀인지 아닌지 True, False 로 반환 MsgBox ActiveCell.MergeArea.Address ‘활성셀이 병합셀이면 병합 셀의 주소를 반환 MsgBox ActiveCell.MergeArea.C ount ‘활성셀이 병합셀이면 병합된 셀의 개수를 반환
03-2 셀 병합 기본 2
1 Dim rng As Range
Set rng = Cells(Rows.Count, “a”).End(3) rng.Offset(-1).Resize(2, 2).Merge
파란 영역이 모두 하나로 병합된다 .
< 결과 >
< 결과 >
2 Dim rng As Range
Set rng = Cells(Rows.Count, “a”).End(3) rng.Offset(-1).Resize(2, 2).Merge True 파란 영역이 행별로 병합된다 .
03-3 병합셀 복사 , 붙여넣기
1 Dim rng As Range
Set rng = Range(“a2”).Resize(, 5)
rng.Copy Range(“d2”).Cells(Rows.Count, “a”).End(xlUp).Offset(1)
2 Dim rng As Range
Set rng = Range(“a2”).MergeArea.Resize(, 5)
rng.Copy Range(“d2”).Cells(Rows.Count, “a”).End(xlUp).Offset(1)
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 15—————————————————–15
1 과 2 의 차이점은 ?
2 번째 , 6 번째 줄의 코드를 보면 MergeArea 가 있고 없고의 차이다 . MergeArea 속성이 있어야 병합된 셀을 가져올 때 , 병합된 형태를 그대로 유지하면서 복사 , 붙여넣기가 된다 . 2 번째 줄처럼 코딩하면 병합이 해제되고 , 해제된 셀의 첫번째 셀값만 가져온다 .
03-4 셀 병합 해제 ★★ [ 엑셀디자인 VBA 16]
Dim rng As Range, c As Range
Set rng = Range(“a1”, Cells(Rows.Count, “a”).End(3)) For Each c In rng
If c.MergeCells Then
With c.MergeArea
.UnMerge .Value = c
End With
End If
Next
A 열에 병합된 셀들을 풀고 , 위쪽 셀의 값으로 채우는 코드이다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 16—————————————————–16
04 실무에서 유용한 배열의 다양한 접근 방법
04-1 특정 영역의 데이터를 다른 영역에 한방에 뿌리기
Dim arr() As Variant ‘셀 범위를 배열로 받을 때는 반드시 Variant
arr = Range(“a2”, Cells(Rows.Count, “a”).End(3))
Worksheets.Add
Range(“a1”, Range(“a1”).Resize(UBound(arr, 1), UBound(arr, 2))) = arr
Erase arr
A2:A10 영역을 한방에 arr 배열 변수에 넣은 후
다른 시트에 같은 행 , 열 사이즈 만큼 영역을 잡아서 arr 배열 변수에 들어온 값을 한방에 뿌려준다 .
그러면 arr 배열 변수에 들어온 사이즈를 어떻게 체크할 수 있는가 ? 바로 Ubound 함수를 사용한다 . 배열과 찰떡 궁합인 함수이다 . Ubound( 배열 , 차원 ) 이 기본 구문이다 .
Ubound(arr,1) 의 의미는 arr 배열 , 1 차원 배열에서 가장 마지막 위치 값을 반환한다 . 이 반대의 함수는 Lbound 함수로서 구문은 동일하며 , 배열에서 처음 위치 값을 반환한다 . 여기서 꼭 알아둬야 할 것은 , 보통 배열은 시작값을 지정하지 않으면 0 부터 시작하는데 , 셀범위를 배열로 받게 되면 무조건 1 부터 시작함을 기억해야 한다 .
작업이 끝나고 나면 , 배열 변수를 메모리에서 비워내는 코드를 넣어주는 것이 처리속도를 높이는 좋은 습관이다 .
04-2 특정 영역의 데이터를 계산 후 다른 영역에 한방에 뿌리기
Dim rng() As Variant Dim arr() As Variant Dim i As Long
rng = Range(“a2”, Cells(Rows.Count, “a”).End(3)) ‘ A 열의 데이터를 배열로 받음 ReDim arr(1 To UBound(rng, 1), 1 To 2) ‘ 계산 한 데 이터를 넣을 배 열 생성
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 17—————————————————–17
For i = 1 To UBound(rng, 1)
arr(i, 1) = Int(rng(i, 1) / 60) ‘나누기 60 의 몫 넣을 arr, 1 차원 배열 arr(i, 2) = rng(i, 1) Mod 60 ‘나누기 60 의 나머지를 넣을 arr, 2 차원 배열
Next
Range(“b2”, Range(“b2”).Resize(UBound(arr, 1), 2)) = arr ‘정확한 배열 사이즈 만큼 arr 뿌리기
Erase rng ‘메모리 비우기 Erase arr
A 열의 데이터를 가지고 와서 특정 영역에 뿌린 후 , 반복문으로 하나 하나의 셀에 수식을 넣어도 되지 않는가 ? 왜 배열로 하는가 ?
배열로 하지 않아도 된다 . 반복문으로 돌려도 괜찮다 . 차이점은 속도에 있다 . 데이터가 얼마 안될 때는 큰 차이가 없으나 , 데이터가 많아지면 많아질수록 속도 차이는 현저히 차이가 난다 . 배열이 어렵지만 자꾸 쓰려고 노력해야 한다 .
반복문을 써서 수식을 넣으면 셀참조를 계속 해야 하는데 , 배열을 사용하면 메모리에서 모든 계산 작업을 끝낸 후 , 한방에 셀에 뿌려지므로 속도가 빨라지는 원리다 .
< 결과 >
04-3 조건을 만족하는 데이터만 배열에 담아 한방에 뿌리기 ★★
Dim c As Range
Dim arr() As Variant
Dim i As Long, cnt As Long
For Each c In Range(“a2”, Cells(Rows.Count, “a”).End(3))
If c.Offset(, 2) = “A” Then
cnt = cnt + 1
ReDim Preserve arr(1 To 3, 1 To cnt) ‘기존 배열 보존
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 18—————————————————–18
For i = 1 To 3
arr(i, cnt) = c.Offset(0, i – 1)
Next
End If
Next
Worksheets.Add
Range(“a1”, Range(“a1”).Resize(UBound(arr, 2), 3)) = Application.Transpose(arr)
이 코드의 특징은
< 결과 >
첫째 , Preserve 키워드를 사용하여 앞에서 생성 된 배열을 보존하고 있다는 점 .
둘째 , 조건에 맞는 값만 새로운 배열에 집어 넣을 때 , 행과 열의 방향이 바뀌도록 한 점 .
셋째 , 행과 열이 바뀐 것을 다시 원래의 형태로 돌리기 위해 transpose 함수를 사용하고 있다는 점이다 .
04-4 특정 시트 한방에 삭제하기 [ 엑셀디자인 VBA 24]
Dim a(2), i As Long
Application.DisplayAlerts = False ‘화면에서 경고창 표시하지 않기
For i = 1 To 3
a(i – 1) = Sheets(ActiveSheet.Index + i – 1).Name ‘시트의 index 속성 활용
Next
Sheets(a).Delete ‘ a 배열 변수에 들어온 시트들을 한방에 삭제하기 Application.DisplayAlerts = True ‘화면에서 경고창 다시 표시하기
배열의 가장 큰 장점은 한방에 In, Out 이 가능하다는 점이다 .
이러한 장점을 활용하여 첫번째 ~ 세번째 시트의 이름을 배열에 담아 한방에 삭제하는 코드이다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 19—————————————————–19
04-5 문자 합치기 ★
Dim a()
Dim c As Range Dim i As Long
For Each c In Columns(“a”).SpecialCells(2)
ReDim Preserve a(i) a(i) = c
i=i+1
Next
Range(“b1”) = Join(a, “,”)
A 열의 데이터를 한 셀에 합쳐서 뿌리는데 , 콤마를 구분기호로 사용한다 . 이런 경우 배열과 Join 함수를 사용하여 보자 .
< 결과 >
04-6 문자 나누기 ★★★ [ 엑셀디자인 VBA 29]
1 Dim s() As String
Dim i As Long
s = Split(Range(“a1″), ” “) For i = 0 To UBound(s) Cells(i + 1, “b”) = s(i)
Next
2 Dim s
Dim i As Long
s = Split(Range(“a1″), ” “) For i = 0 To UBound(s) Cells(i + 1, “b”) = s(i)
Next
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 20—————————————————–20
3 Dim s
Dim i As Long
For Each s In Split(Range(“a1″), ” “)
Cells(i + 1, “b”) = Trim(s) i=i+1
Next
Split 으로 잘려진 문자들은 반드시 배열에 담아야
< 결과 >
한다 . 그럼 어떤 형태의 배열에 담아야 하는가 ? 1 번과 2 번의 각 첫줄 코드를 보면 알 수 있다 .
‘Dim s () as string’ 또는 ‘ D im s’ 두가지 형태만이 가능하다 . 이 부분을 정확히 외워두자 .
3 : 1,2 번의 코드를 For Each ~ Next 문으로 변환한
것이다 . 왜 ? For~Next 문보다 조금 더 빠르고 , 똑똑한 구조이니까 .
여기서 ‘ D im s’는 For Each 다음에 오는 변수는 반드시 개체변수로 받아야 하는데 , 셀도 아니고 , 차트도 아니므로 모든 타입을 포함하는 Variant 타입으로 받아야 한다 . 이러한 디테일한 문법을 정확히 알고 있어야 코딩 시간을 단축할 수 있다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 21—————————————————–21
05 배열 vs. 컬렉션
05-1 컬렉션 개체로 특정 영역의 데이터 한방에 담기 ★
Dim nc As New Collection Dim i As Long
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
For Each c In rng
nc.Add c.Value
Next
Collection 은 특별한 유형의 개체로 , 순서가 지정된 항목의 집합이다 .
배열과 비슷한 개념이다 . 배열에 비해 데이터를 모으는 코드가 짧아서 좋다 . 또한 index 번호가 1 부터 시작하는 특징을 갖고 있다 .
< 결과 >
05-2 컬렉션 개체로 조건에 맞는 데이터만 한방에 담기 ★
Dim nc As New Collection
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
For Each c In rng
If c = “A” Then
nc.Add c.Offset(, 1).Value
End If
Next
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 22—————————————————–22
Collection 개체로 조건에 맞는 데이터만 Collection 에 담을 때 배열처럼 코드가 복잡하지 않다 . 간단하다 . 이유는 Collection 개체는 삽입 , 삭제가 자유롭기 때문이다 .
< 결과 >
05-3 컬렉션 개체로 중복되지 않은 고유한 항목만 담기 [ 엑셀디자인 VBA 26]
Dim nc As New Collection
Dim rng As Range, c As Range
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
On Error Resume Next ‘반드시 넣어 주어야 함
For Each c In rng
If Len(c) Then
nc.Add c.Value, CStr(c)
End If
Next
On Error GoTo 0 ‘반드시 넣어 주어야 함
Collection 에서 항목 추가시 기본 구문은
< 결과 >
‘변수명 . Add(Item,Key)’이다 두번째 매개변수인 Key 값을 넣게 되면 이것으로 고유항목만 담을 수 있게 된다 . 배열은 자체적으로 이런 옵션이 없다 .
05-4 컬렉션 개체의 단점
1 Dim nc As New Collection ‘컬렉션 개체의 항목을 영역에 뿌리기
Dim rng As Range, c As Range Dim a()
Dim i As Long
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(3))
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 23—————————————————–23
For Each c In rng
If Len(c) Then nc.Add c.Value
Next
ReDim a(nc.Count – 1)
For i = 0 To nc.Count – 1 ‘새로운 배열에 담는 과정
a(i) = nc(i + 1)
Next
Range(“c1”).Resize(nc.Count) = Application.Transpose(a)
2 Dim a ‘배열에 담긴 항목을 영역에 뿌리기
a = Range(“a2”, Cells(Rows.Count, “a”).End(3))
Range(“c1”).Resize(UBound(a)).Value = a ‘ 배 열은 한방 에 뿌 리 기 가능
< 결과 >
Collection 개체에 담긴 항목들은 배열처럼 특정 영역에 한방에 데이터를 뿌릴 수 없다 . 따라서 새로운 배열을 생성해서 그곳에 담았다가 다시 특정영역에 뿌려야 한다 .
배열과 Collection 의 장단점을 잘 파악해서 실무에 적용해야한다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 24—————————————————–24
06 Dir 함수로 파일과 폴더 핸들링
06-1 특정 파일의 존재 여부 확인
Dim FN As String ‘바탕화면 Test 폴더 내 , test.xlsx 파일의 존재 여부를 체크하는 코드 FN = Dir(Environ(“userprofile”) & “DesktopTesttest.xlsx”)
If FN <> “” Then
MsgBox FN
Else
MsgBox ” 파일이 존재하지 않습니다 “
End If
Dir 함수는 지정된 경로에서 첫번째 파일 이름 또는 폴더 이름을 반환해주는 함수
Dir 다음의 괄호안에 찾을 파일의 경로를 넣으면 된다 . 만약 해당 파일이 바탕화면에 위치하고 있다면 Environ 함수를 사용하여 ‘ Environ(“userprofile”) ’ 이렇게 입력해야 한다 . 그렇지 않으면 PC 마다 사용자 이름이 모두 다르므로 에러가 발생한다 .
06-2 특정 폴더의 존재 여부 확인
Dim PN As String ‘바탕화면에 Test 폴더의 존재 여부를 체크하는 코드 Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest” FN = Dir(PN, vbDirectory)
If FN <> “” Then
MsgBox FN & ” 존재 “
Else
MsgBox ” 해당 폴더가 존재하지 않음 “
End If
Dir 함수는 보통 실무에서 첫번째 인수만 쓴다 . 그러면 지정 폴더 내 , 첫번째 파일의 이름을 반환해준다 . ‘ Dir(PN, vbDirectory) ’ 이처럼 두번째 인수에 ‘ vbDirector y’를 입력하면 속성이 없는 파일 외에 디렉토리 또는 폴더의 이름을 반환해준다 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 25—————————————————–25
06-3 특정 폴더의 존재 여부를 확인해서 없으면 만들기
Dim PN As String Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN, vbDirectory) ‘ FN 에는 ‘ T est’ 폴더의 이름이 저장됨
If FN <> “” Then
MsgBox FN & ” 폴더가 존재합니다 “
Else
MkDir PN ‘★ MsgBox ” 폴더가 만들어졌습니다 “
End If
FN 변수에 들어온 ‘Test’란 이름의 폴더가 PN 변수에 들어온 경로에 존재하는지 확인해 보고 , 없으면 디렉토리 또는 폴더를 새로 만들어주는 MkDir 함수로 PN 변수의 경로에 ‘ T est’란 이름의 폴더를 생성하는 코드이다 .
06-4 특정 폴더 내 , 모든 폴더 및 파일 이름 가져오기
Dim FN As String
FN = Dir(Environ(“userprofile”) & “DesktopTest”, vbDirectory)
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN
FN = Dir() ‘다시 Dir 함수 호출
Loop
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 26—————————————————–
바탕화면 Test 폴더 내에 존재하는 모든 폴더와 파일의 이름을 시트에 뿌리는 코드
Dir 함수는 지정된 경로에서 첫번째 파일 또는 폴더 이름만 반환해주므로 반복문을 사용해서 모든 파일과 폴더의 이름을 반환받도록 해야 한다 .
이름이 뿌려진 결과를 보면 점이 출력된다 . single dot(.) 은 현재 디렉토리 , double dot(..) 은 상위 디렉토리를 의미한다 .
06-5 특정 폴더 내 , 모든 폴더의 이름 가져오기
Dim PN As String Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest” FN = Dir(PN, vbDirectory)
Do While FN <> “”
26
< 결과 >
If GetAttr(PN & FN) = vbDirectory Then Cells(Rows.Count, “a”).End(3)(2) = FN
End If
FN = Dir() Loop
06-6 특정 폴더 내 , 모든 파일의 이름 가져오기
Dim PN As String Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest”
FN = Dir(PN) ‘vbDirectory 를 지정하지 않으면 파일 이름만 반환
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN FN = Dir()
Loop
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
< 결과 >
< 결과 >
—————————————————–Page 27—————————————————–27
06-7 특정 폴더 내 , 첫번째 엑셀 파일의 이름 가져오기
Dim FN As String Dim PN As String
PN = Environ(“userprofile”) & “DesktopTest” FN = Dir(PN & “*.xls*”)
MsgBox FN
06-8 특정 폴더 내 , 모든 엑셀 파일의 이름 가져오기 ★
Dim PN As String Dim FN As String
PN = Environ(“userprofile”) & “DesktopTest” FN = Dir(PN & “*.xls*”)
Do While FN <> “”
Cells(Rows.Count, “a”).End(3)(2) = FN FN = Dir()
Loop
< 결과 >
06-9 특정 폴더 내 , 모든 엑셀 파일 통합하기 ★★★ [ 엑셀디자인 VBA 93]
Dim PN As String, FN As String Dim wb As Workbook Dim ws As Worksheet
Application.ScreenUpdating = False
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 28—————————————————–28
PN = Environ(“userprofile”) & “DesktopTest” FN = Dir(PN & “*.xls*”)
If FN = “” Then
MsgBox ” 폴더에 파일이 없습니다 ” Exit Sub
End If ‘ To do
Do While FN <> “”
Set wb = Workbooks.Open(Filename:=PN & FN, UpdateLinks:=0 ) Set ws = wb.Sheets(1)
‘To do
wb.Close False FN = Dir()
Loop
Application.ScreenUpdating = True
Set wb = Nothing Set ws = Nothing
특정 폴더 내 , 존재하는 엑셀 파일들을 Dir 함수를 통해 하나씩 열어서 필요한 작업을 진행하는 코드 . ‘To do’ 라고 쓰여진 곳에 필요한 작업을 위한 코드를 넣으면 된다 .
‘UpdateLinks:=0’ 이 부분은 열려진 파일 내에 다른 파일을 참조하는 수식이 들어가 있는 경우 파일을 업데이트 하겠냐는 메시지 창이 뜨는 것을 막아주는 옵션이다 .
06-10 특정 파일만 자동으로 가져와서 작업하기 ★★★
Dim FN As String
Dim wb As Workbook Dim ws As Worksheet
Application.ScreenUpdating = False
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 29—————————————————–29
FN = Environ(“userprofile”) & “DesktopTestTest.xlsx”
If IsFileExist(FN) = False Then
MsgBox ” 파일이 존재하지 않습니다 ” Exit Sub
End If
If IsFileOpen(FN) = True Then
MsgBox ” 파일이 이미 열려 있습니다 . 닫고 다시 시작하세요 ” Exit Sub
End If
Set wb = Workbooks.Open(Filename:=FN, UpdateLinks:=0) Set ws = wb.Sheets(1)
‘To do
wb.Close False
Application.ScreenUpdating = True
Set wb = Nothing Set ws = Nothing
< 사용자정의 함수 1>
Function IsFileExist(FN As String) As Boolean
IsFileExist = (Dir(FN) <> “”)
End Function
< 사용자정의 함수 2>
Function IsFileOpen(FN As String) As Boolean
Dim OpenFName As Workbook
On Error Resume Next
①
②
①
②
Set OpenFName = Workbooks(Dir(FN)) IsFileOpen = (Err.Number = 0)
End Function
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 30—————————————————–30
특정한 파일만 가져와서 작업을 할 때는 해당 파일이 존재하는지 , 이미 열려져 있는지를 확인해주는 코드를 삽입해야 불필요한 에러를 막을 수 있다 .
①은 파일의 존재여부를 체크해주는 코드와 사용자정의 함수 ②은 파일이 열려있는지 체크해주는 코드와 사용자정의 함수
06-11 특정 폴더를 유저가 선택해서 파일 통합하기 ★★★
Dim PN As String, FN As String Dim wb As Workbook Dim ws As Worksheet
Application.ScreenUpdating = False
ChDir ThisWorkbook.Path ‘현재 이 매크로 파일과 같은 경로의 디렉토리를 기본 With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
PN = .SelectedItems(1) & “”
End If End With
FN = Dir(PN & “*.xls*”) If FN = “” Then
MsgBox ” 폴더에 파일이 없습니다 ” Exit Sub
End If
Do While FN <> “”
Set wb = Workbooks.Open(Filename:=PN & FN, UpdateLinks:=0) Set ws = wb.Sheets(1)
‘To do
wb.Close False FN = Dir()
Loop
Application.ScreenUpdating = True Set wb = Nothing Set ws = Nothing
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 31—————————————————–31
작업할 엑셀 파일들이 존재하는 폴더를 대화상자를 통해 유저가 직접 선택하도록 하는 코드 . FileDialog 속성을 활용하면 된다 .
‘ C hDir’ 는 현재 디렉토리 또는 폴더를 변경하는 구문으로서 이 줄은 빼도 상관없다 . 하지만 이 코드를 삽입하면 현재 매크로 파일이 위치하고 있는 폴더를 기준으로 폴더 선택 대화상자가 나타나므로 유저의 편의성을 고려한 코드이다 .
06-12 특정한 파일을 유저가 선택해서 작업하기 ★
Dim FD As FileDialog Dim FN As Variant
Dim wb As Workbook Dim ws As Worksheet
Application.ScreenUpdating = False
ChDir ThisWorkbook.Path
Application.FileDialog(msoFileDialogFilePicker).Filters.Add “Excel Files”, “*.xls*”
Set FD = Application.FileDialog(msoFileDialogFilePicker) With FD
.AllowMultiSelect = True ‘ 여러개 파일 선택 ‘.AllowMultiSelect = False ‘ 한 개 파일 선택 If .Show Then
For Each FN In .SelectedItems
Set wb = Workbooks.Open(Filename:=FN, UpdateLinks:=0) Set ws = wb.Sheets(1)
‘To do
wb.Close False
Next
End If
End With
Application.ScreenUpdating = True
Set wb = Nothing Set ws = Nothing
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 32—————————————————–32
FileDialog 속성을 활용하여 유저가 원하는 여러 개 파일 ( 엑셀 ) 또는 하나의 파일을 선택하여 작업할 수 있다 .
.AllowMultiSelect 속성이 True 이면 여러 개 파일 , False 이면 하나의 파일을 선택할 수 있도록 해준다 .
06-13 워크시트를 새 파일로 생성하기 ★★★
Dim PN As String, FN As String
Application.ScreenUpdating = False
1 PN = ThisWorkbook.Path & “” 2 FN = ActiveSheet.Name & “.xlsx”
3 If Dir(PN & FN) <> “” Then Kill PN & FN
4 ActiveSheet.Copy
5 ActiveSheet.Buttons.Delete
ActiveWorkbook.SaveAs Filename:=PN & FN ActiveWorkbook.Close
Application.ScreenUpdating = True
1 : 현재 이 매크로 파일의 경로와 같은 위치에 2 : 현재 활성화된 시트의 이름을 파일 이름으로
3 : 만약에 해당 경로에 같은 이름의 파일이 존재하면 Kill 함수로 해당 파일을 삭제
4 : 현재 활성화된 시트를 복사 .. 하라는 이 코드 자체가 새 파일을 생성해서 그곳에 붙여넣기 됨 5 : 붙여넣기 된 매크로 버튼을 삭제
06-14 모든 워크시트를 각각의 새 파일로 생성하기 ★★★
Dim PN As String, FN As String Dim sh As Worksheet
Application.ScreenUpdating = False
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 33—————————————————–33
PN = ThisWorkbook.Path & “”
For Each sh In ThisWorkbook.Worksheets
FN = sh.Name & “.xlsx”
If Dir(PN & FN) <> “” Then Kill PN & FN
sh.Copy
ActiveSheet.Buttons.Delete
ActiveWorkbook.SaveAs Filename:=PN & FN ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Set sh = Nothing
현재 이 매크로 파일의 모든 시트를 각각의 새 파일로 생성하여 저장 06-13 코드에 for each~next 반복문을 추가하여 완성
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 34—————————————————–34
07 Like 연산자 패턴들 ★ [ 엑셀디자인 VBA 18~20]
1 If Range(“a1”) Like “[ 가 – 힣 ]” Then 2 If Range(“a1”) Like “[A-Z]” Then 3 If Range(“a1”) Like “[0-9]” Then 4 If Range(“a1”) Like “[ABC]” Then 5 If Range(“a1”) Like “[!A-C]” Then 6 If Range(“a1”) Like “*[A-H]*” Then 7 If Range(“a1”) Like “*##” Then
8 If Range(“a1”) Like “###[-.]####[-.]####” Then
1 : A1 셀의 값이 한글이면…
2 : A1 셀의 값이 알파벳 대문자이면… 3 : A1 셀의 값이 숫자이면…
4 : A1 셀의 값이 영문 대문자 A 또는 B 또는 C 이면…
5 : A1 셀의 값이 영문 대문자 A 또는 B 또는 C 셋다 아니면… 6 : A1 셀의 값 중간에 영문 대문자 A~H 사이의 문자가 있으면… 7 : A1 셀의 값이 앞쪽은 문자 , 끝문자가 두자리 숫자로 끝나면… 8 : A1 셀의 값이 하이픈 또는 점이 있는 핸드폰 번호와 일치하면…
08 시트 통합 ★★★ [ 엑셀디자인 VBA 88]
Dim sh As Worksheet
Application.ScreenUpdating = False
Sheet1.Cells.Clear ‘데이터가 통합될 시트의 기존 데이터 삭제
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> ActiveSheet.Name Then ‘매크로 버튼이 있는 통합 시트 제외
‘ To do
End If
Next
Application.ScreenUpdating = True
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 35—————————————————–35
09 정렬
09-1 정렬 기본 ★ [ 엑셀디자인 VBA 30~31]
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
ActiveSheet.Sort.SortFields.Clear ‘기존 정렬 명령 제거
rng.Sort Range(“a1”), 1, Header:=xlYes ‘오름차순 정렬 , 제목필드 포함 ‘rng.Sort Range(“a1”), 2, Header:=xlYes ‘내림차순 정렬 , 제목필드 포함
09-2 여러 필드 정렬 (3 개까지만 )
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion ActiveSheet.Sort.SortFields.Clear
With rng
.Sort key1:=.Cells(1, 1), order1:=2, _
key2:=.Cells(1, 2), order2:=1, _ key3:=.Cells(1, 3), order3:=1, _ Header:=xlYes
End With
09-3 여러 필드 정렬 (3 개 이상 ~) ★
Dim i As Long
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 36—————————————————–36
With ActiveSheet.Sort
.SortFields.Clear
For i = 1 To rng.Columns.Count
.SortFields.Add Key:=Cells(1, i), Order:=2
Next
.SetRange rng ‘ 정렬 범위 .Header = xlYes ‘제목필드 포함
.MatchCase = False ‘대 , 소문자 구분 안함
.Orientation = xlTopToBottom ‘위에서 아래 방향으로 정렬 .SortMethod = xlPinYin ‘2 Byte 언어 .Apply
End With
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 37—————————————————–37
10 필터
10-1 자동 필터 ★★ [ 엑셀디자인 VBA 32~33]
Dim sh1 As Worksheet Dim rng As Range
Set sh1 = Sheets(” 자동필터 “)
Set rng = sh1.Range(“a1”).CurrentRegion
1 If sh1.AutoFilterMode = 0 Then rng.AutoFilter 2 If sh1.FilterMode Then sh1.ShowAllData
3 rng.AutoFilter 2, Range(“e2”) Range(“a22”).CurrentRegion.Clear
4 If rng.SpecialCells(xlCellTypeVisible).Count = 3 Then
MsgBox ” 해당되는 데이터 없음 ” sh1.ShowAllData Exit Sub
End If
5 rng.SpecialCells(xlCellTypeVisible).Copy Range(“a22”) 6 sh1.ShowAllData
1 : sh1 시트에 자동필터가 설정되어 있지 않으면 rng 영역에 자동필터를 끼워라
2 : sh1 시트에 자동필터가 끼워져 있고 , 필터링이 적용되어 있으면 , 필터링 해제하여 데이터를 모두 보여라
3 : rng 영역 , 2 번째 필드에 e2 셀의 값으로 조건으로 하여 필터링을 해라
4 : 만약 필터링 적용 후 , rng 영역에 보여지는 셀의 개수가 3 이면 ( 조건에 맞는 데이터가 없으면 ) 메시지 박스로 안내하고 , 필터링 해제 후 프러시저를 빠져 나가라
5 : 조건에 맞는 데이터가 있으면 rng 영역을 기준으로 화면에 보여지는 데이터만 Copy>Paste 6 : 다시 필터링 해제해서 모든 데이터를 보여라
10-2 고급 필터 ★★ [ 엑셀디자인 VBA 35]
Dim rng As Range
Set rng = Range(“a1”).CurrentRegion
rng.AdvancedFilter xlFilterCopy, Range(“e1:e2”), Range(“a25”)
rng 영역에서 e1:e1 셀의 조건을 만족하는 데이터를 a25 셀부터 붙여 넣어라
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 38—————————————————–38
11 Find 로 특정 문자 찾기
11-1 Find 기본 ( 찾아야 할 셀이 하나일 때 ) ★★★ [ 엑셀디자인 VBA 42]
Dim rng As Range, cf As Range
Range(“e2”).ClearContents
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(xlUp))
Set cf = rng.Find(Range(“d2”).Value, , , xlWhole) ‘ d2 셀과 전체 일치되는 셀을 찾아 변수에 담기
If Not cf Is Nothing Then ‘★ 찾는값이 있으면…
Range(“e2”) = cf.Offset(,1)
Else
MsgBox ” 찾는 제품코드가 없습니다 .” ‘★ 찾는값이 없으면
End If
Find 메서드는 찾는 값이 없으면 에러가 발생하므로 반드시 ★표시 코드처럼 에러 처리 코드를 추가해야 한다 .
11-2 Find 응용 ( 찾아야 할 셀이 여러 개일 때 ) ★★★ [ 엑셀디자인 VBA 43~45]
Dim rng As Range, cf As Range Dim adr As String Dim i As Long
Set rng = Range(“a2”, Cells(Rows.Count, “a”).End(xlUp))
Set cf = rng.Find(“A-1”, , , xlWhole) ‘ A-1 이라는 문자와 전체 일치되는 셀을 찾아 변수에 담기
If Not cf Is Nothing Then ‘찾는 값이 있으면 아래 루프를 돌고 , 없으면 무시
adr = cf.Address Do
cf.Interior.ColorIndex = 43 ‘이곳에 찾았을 때 실행해야 할 코드 입력
Set cf = rng.FindNext(cf) ‘ Find 로 시작된 검색을 FindNext 메서드로 계속 검색 진행
Loop Until cf.Address = adr
End If
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 39—————————————————–39
12 데이터집계를 위한 피벗 생성
12-1 피벗 생성 기본 ★★★ [ 엑셀디자인 VBA 53]
Dim pt As PivotTable Dim pc As PivotCache
Dim sd As Worksheet, ss As Worksheet Dim rngS As Range, rngD As Range
Application.ScreenUpdating = False
Set ss = Sheets(“raw”) ‘ raw data 시트 Set sd = Sheets(” 피벗 “) ‘피벗 생성될 시트
Set rngS = ss.Range(“a1”).CurrentRegion ‘피벗의 원본 데이터 범위 Set rngD = sd.Range(“a1”) ‘피벗 생성될 시작 셀
sd.Cells.Clear
Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngS) ‘피벗 캐쉬 영역이 먼저 생성 Set pt = pc.CreatePivotTable(rngD, “pv1”) ‘캐쉬 영역을 기반으로 피벗 생성
With pt
.AddFields ” 연령 “, ” 발신지 _ 구 ” ‘연령별 ( 행 ), 발신지구별 ( 열 ) .AddDataField .PivotFields(” 통화건수 “), , xlSum ‘통화건수 ( ∑값 ) 의 합계
End With
Application.ScreenUpdating = True
Set sd = Nothing Set ss = Nothing
Set rngS = Nothing Set rngD = Nothing
피벗 생성을 위한 기본 코드 .
길어 보이지만 파란색 영역이 메인 코드이고 나머지는 부수적으로 딸려오는 부분 .
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 40—————————————————–40
12-2 피벗 생성 기본 Plus ★★ [ 엑셀디자인 VBA 54]
Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rngS) ‘피벗 캐쉬 영역이 먼저 생성 Set pt = pc.CreatePivotTable(rngD, “pv1”) ‘캐쉬 영역을 기반으로 피벗 생성
With pt
.AddFields ” 연령 “, ” 발신지 _ 구 ” ‘연령별 ( 행 ), 발신지구별 ( 열 ) .AddDataField .PivotFields(” 통화건수 “), , xlSum ‘통화건수 ( ∑값 ) 의 합계
.RowAxisLayout xlTabularRow ‘보고서 레이아웃 : 테이블 형식 .RowGrand = False ‘행 총합계 표시 안함 .ColumnGrand = False ‘열 총합계 표시 안함
For Each f In .PivotFields ‘필드별 부분합 표시 안함
f.Subtotals(1) = False
Next
End With
12-3 피벗의 다양한 범위 참조 ★★
pt.TableRange1.Select
pt.TableRange2.Select
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 41—————————————————–41
pt.RowRange.Select
pt.ColumnRange.Select
pt.DataLabelRange.Select
pt.DataBodyRange.Select
pt.PageRange.Select
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 42—————————————————–42
pt.PivotFields(” 요일 “).LabelRange.Select
pt.PivotFields(” 요일 “).DataRange.Select
pt.PivotFields(” 요일 “).PivotItems(” 월 “).LabelRange.Select
pt.PivotFields(” 요일 “).PivotItems(” 월 “).DataRange.Select
pt.PivotFields(” 연령 “).PivotItems(“30 대 “).LabelRange.Select
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 43—————————————————–43
pt.PivotFields(” 연령 “).PivotItems(“30 대 “).DataRange.Select
pt.PivotFields(” 연령 “).DataRange.Select
Intersect(pt.PivotFields(” 연령 “).PivotItems(“30 대 “).DataRange.EntireRow, pt.DataBodyRange).Select
피벗의 다양한 범위를 참조하기 위해서는 피벗의 각 범위의 이름을 정확히 알아야 한다
12-4 피벗 슬라이서 생성과 위치 지정 ★ [ 엑셀디자인 VBA 56]
Dim scc As SlicerCache Dim scr As Slicer
Dim ss As Worksheet Dim pt As PivotTable Dim rng As Range
Set ss = Sheets(” 피벗 “)
Set pt = ss.PivotTables(“pv1”)
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 44—————————————————–44
On Error Resume Next
ThisWorkbook.SlicerCaches(” 성별 _scc”).Delete ‘기존 슬라이서 삭제
On Error GoTo 0
Set scc = ThisWorkbook.SlicerCaches.Add2(pt, ” 성별 “, ” 성별 _scc”) ‘슬라이서 캐쉬 생성 Set scr = scc.Slicers.Add(ss, , ” 성별슬라이서 “, ” 성별선택 “) ‘슬라이서 생성
Set rng = ss.PivotTables(“pv1”).TableRange1
scr.Top = rng.Top ‘슬라이서 위치 지정 scr.Left = rng.Left + rng.Width + 20 scr.Height = rng.Height scr.Width = 200
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 45—————————————————–45
13 차트
13-1 차트 생성 기본 ★★★ [ 엑셀디자인 VBA 62]
Dim ws As Worksheet
Dim rs As Range, rd As Range Dim sh As Shape Dim ch As Chart
Set ws = Sheets(“raw”) ‘ raw 시트
Set rs = ws.Range(“a1:b10”) ‘ a1:b10 영역이 차트 원본 영역
On Error Resume Next
ws.ChartObjects.Delete ‘ raw 시트에 차트가 있으면 삭제
On Error GoTo 0
‘ 차트생성 : 차트는 shape > chart 순으로 만들어짐
Set sh = ws.Shapes.AddChart(XlChartType.xlColumnClustered) ‘차트 종류의 이름 Set ch = sh.Chart
‘ 차트 요소 생성 With ch
.SetSourceData rs ‘차트 원본범위 .HasTitle = True ‘차트 제목 설정 .ChartTitle.Text = ” 제품별 판매수량 ” ‘차트 제목 입력 .HasLegend = False ‘범례 해제
End With
‘ 차트 이름 , 위치 , 크기 With sh
Set rd = ws.Range(“f1:j10”) ‘차트가 들어갈 범위를 설정 .Name = “cht1” ‘차트 이름 .Top = rd.Top ‘차트 위치 .Left = rd.Left ‘차트 위치 .Width = rd.Width ‘차트 사이즈 .Height = rd.Height ‘차트 사이즈
End With
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 46—————————————————–46
13-2 분산형 차트에 레이블 추가 및 마커 변경 ★ [ 엑셀디자인 VBA 89]
Dim rng As Range, rd As Range Dim sh As Shape Dim ch As Chart
Dim ser As Series
Dim i As Integer, j As Integer Dim c As Range, lbl As Range
Set rng = Sheet1.Range(“b2”, Sheet1.Cells(Rows.Count, “c”).End(3))
On Error Resume Next
Sheet1.ChartObjects.Delete
On Error GoTo 0
‘ 차트 생성
Set sh = Sheet1.Shapes.AddChart2(, xlXYScatter) Set ch = sh.Chart
‘ 차트 요소 생성 With ch
.SetSourceData rng .HasTitle = True
.ChartTitle.Text = ” 제품별 사이즈 측정 ” .HasLegend = False
End With
‘ 차트 이름 , 위치 , 크기 With sh
Set rd = Sheet1.Range(“e1:j11”) .Name = “cht1” .Top = rd.Top .Left = rd.Left
.Width = rd.Width .Height = rd.Height
End With
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 47—————————————————–47
‘ 레이블 추가
Set ser = Sheet1.ChartObjects(1).Chart.SeriesCollection(1) ‘데이터계열 추가
Set lbl = Sheet1.Range(“a2”, Sheet1.Range(“a2”).End(xlDown)) ‘레이블로 삼을 A 열의 데이터 ser.HasDataLabels = True
For Each c In lbl ‘데이터 계열 하나 하나 포인트에 레이블 적용 (A 열의 값 )
i=i+1
ser.Points(i).DataLabel.Text = c.Value
Next
‘ 일정한 조건 갖추면 마커 모양 및 색상 변경 Dim Yvals, Xvals
Yvals = ser.Values Xvals = ser.XValues
For i = LBound(Yvals) To UBound(Yvals)
If Yvals(i) >= 170 And Xvals(i) >= 65 Then ‘원하는 조건 입력 (B 열과 C 열의 데이터 기준 )
With ser.Points(i)
.MarkerBackgroundColor = RGB(255, 0, 0) ‘마커 색상 .MarkerStyle = -4168 ‘마커 모양
End With
End If
Nex
분산형 차트는 엑셀 기능 자체에서 레이블 적용이 되질 않는다 . 따라서 VBA 로 각 항목별 레이블 적용하고 , 특정값을 만족하는 항목은 마커의 모양과 색상을 달리하는 코드이다 .
< 결과 >
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 48—————————————————–48
13-3 차트 삭제 ★★
1 Dim sh As Worksheet
Set sh = Sheet1
If sh.ChartObjects.Count Then sh.ChartObjects.Delete
2 Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.ChartObjects.Count Then
sh.ChartObjects.Delete
End If
Next
1 : 단일 시트에 존재하는 모든 차트 삭제 2 : 모든 시트들의 모든 차트 삭제
14 클래스 모듈 코딩 순서 (feat. 차트 ) [ 엑셀디자인 VBA 104~108]
1. 클래스 모듈 만들기
2. 클래스 모듈에 차트를 참조하는 전역변수 선언 3. 표준모듈과 연결하기 – 모 듈 수준의 변 수 선 언 – 표준모듈 작성
4. 클래스 모듈에 이벤트 프로시저 작성
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 49—————————————————–49
15 텍스트 파일 핸들링
15-1 특정 경로의 텍스트 파일 가져오기 [ 엑셀디자인 VBA 109]
Dim c As Range
Dim FilePath As String Dim data As String Dim i As Integer Dim arr
Set c = Sheet1.Range(“a1”) c.CurrentRegion.Clear
FilePath = Environ(“userprofile”) & “DesktopVBA_109 학자금상환현황 .txt” Open FilePath For Input As #1
Do Until EOF(1)
Line Input #1, data
arr = Split(data, “,”)
c.Offset(i).Resize(1, UBound(arr) + 1) = arr i=i+1
Loop
Close #1
c.CurrentRegion.Columns.AutoFit
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 50—————————————————–50
15-2 폴더 내 , 모든 텍스트 파일 가져오기 [ 엑셀디자인 VBA 110]
Dim c As Range, FilePath As String, FileName As String Dim data As String
Dim i As Integer, FileNum As Integer Dim arr
Sheet1.Cells.Clear
Set c = Sheet1.Range(“a1”) ‘ 폴더 선택 & 경로
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
FilePath = .SelectedItems(1) & “”
End If End With
‘ 폴더 내 , 텍스트 파일 존재 여부 FileName = Dir(FilePath & “*.txt”) If FileName = “” Then
MsgBox ” 폴더 내 , 텍스트 파일이 없습니다 ” Exit Sub
End If
Do While FileName <> “”
FileNum = FreeFile
Open FilePath & FileName For Input As #FileNum
Do Until EOF(FileNum)
Line Input #FileNum, data arr = Split(data, “,”)
If arr(0) <> ” 구분 1″ Then
c.Offset(i).Resize(1, UBound(arr) + 1) = arr i=i+1
End If
Loop
Close #FileNum FileName = Dir
Loop
c.CurrentRegion.Columns.AutoFit
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 51—————————————————–51
16 위 , 아래 데이터가 같은지 다른지 비교해서 작업하기 ★★
For Each c In rng
If c.Value = c.Offset(1).Value Then
i=i+1
Else
If i = 0 Then ‘같지 않으면
‘ To do
Else ‘같으면
‘To do
End If
i=0
End If
Next
실무에서 데이터의 위 , 아래 셀을 비교하여 같을 때 , 다를 때 데이터를 이동시켜 재배치하는 작업
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 52—————————————————–52
17 특정 색상이 칠해진 여러 셀 선택하기 [ 엑셀디자인 VBA 115]
Dim rng As Range, cf As Range, uni As Range Dim adr As String
Application.FindFormat.Clear
Application.FindFormat.Interior.ColorIndex = 6
Set rng = Columns(“a”).SpecialCells(2) Set cf = rng.Find(“*”, searchformat:=True)
If cf Is Nothing = 0 Then
adr = cf.Address Do
If uni Is Nothing Then
Set uni = cf
Else
Set uni = Union(uni, cf)
End If
Set cf = rng.Find(“*”, after:=cf, searchformat:=True)
Loop While cf.Address <> adr
End If
If uni Is Nothing = 0 Then uni.Select
Application.FindFormat.Clear
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 53—————————————————–53
18 프로시저 처리 속도 확인 ★★★
Dim sT As Date, eT As Date sT = Timer ‘실행 코드
eT = Timer
MsgBox Format(eT – sT, “0000.00000”) & ” 초 “
초를 체크하는 Timer 함수를 활용 .
프로시저 끝난 시간 (eT) – 프로시저 시작 시간 (sT) 을 메시지 박스로 보여줌
19 Application.InputBox 메서드 에러 처리
19-1 숫자를 반환할 때 ★
Dim MyRow As Long
Application.DisplayAlerts = False
On Error Resume Next
MyRow = Application.InputBox(” 작업할 행을 입력하세요 “, Type:=1) ‘숫자만 입력 If err Then Exit Sub
‘To do
Application.DisplayAlerts = True
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 54—————————————————–54
19-2 셀주소를 반환할 때 ★
Dim MyRng As Range
Application.DisplayAlerts = False
On Error Resume NextTA:
Set MyRng = Application.InputBox(” 셀범위를 드래그하세요 “, Type:=8) ‘셀 참조만 가능 If err Then Exit Sub
If MyRng.Count = 1 Then
MsgBox “2 개 이상의 셀을 선택해야 합니다 ” GoTo TA
End If
‘ To do
On Error GoTo 0
Application.DisplayAlerts = True
20 시트 보호되어 있는 시트에서 매크로 작업 가능하도록 하기
Sub 메인프로시저 ()
Dim sh As Worksheet Set sh = Sheet1
Call fnUnProtect(sh)
‘To do
Call fnProtect(sh)
End Sub
Sub fnProtect(sh As Worksheet)
sh.Protect Password:=”1234567″, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowFiltering:=True
End Sub
Sub fnUnProtect(sh As Worksheet)
sh.Unprotect “1234567”
End Sub
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 55—————————————————–55
21 시트의 그림 모두 지우기
Activesheet.Pictures.Delete
22 시트를 복사 또는 이동 시 , objects 는 제외시키기
Application.CopyObjectsWithCells = False
Sheet1.Copy
Application.CopyObjectsWithCells = True
23 통합문서 내 , 모든 이름정의 삭제
Dim na As Name
For Each na In ActiveWorkbook.Names
na.Delete
Next
24 Type 판별
msgbox selection.shaperange.type ‘도형 종류 판별
If Typename(selection) <> “Range” Then exit sub ‘셀 개체인지 아닌지 판별
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 56—————————————————–56
25 버튼 캡션을 셀에 입력하기
Dim btn as button
Set btn = Activesheet.Buttons(Application.Caller) Activecell = btn.Caption
26 하이퍼링크 걸기
Dim rng As Range, c As Range
Set rng = Range(“b2:b15”) For Each c In rng
If Not c.Hyperlinks.Count > 0 Then
c.Hyperlinks.Add anchor:=c, Address:=c.Value
End If
Next
ⓒ 2020. 데이터디자인연구소 Co. all rights reserved.
—————————————————–Page 57—————————————————–
사용자정의 함수, 숫자만
https://www.youtube.com/watch?v=5SpvwJeDze4