VBA

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_folder\PG\전기요금\전기요금단가표”

    ActiveWorkbook.SaveAs Filename:= _

        “N:\. Personal_folder\PG\전기요금\전기요금단가표\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”) & “\Desktop\Test\test.xlsx”)

   If FN <> “” Then

      MsgBox FN

   Else

      MsgBox “파일이 존재하지 않습니다”

   End If

<06-2 특정 폴더의 존재 여부 확인>

   Dim PN As String

   Dim FN As String

   PN = Environ(“userprofile”) & “\Desktop\Test”

   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”) & “\Desktop\Test”

   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”) & “\Desktop\Test\”, 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”) & “\Desktop\Test\”

   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”) & “\Desktop\Test\”

   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”) & “\Desktop\Test\”

   FN = Dir(PN & “*.xls*”)

   MsgBox FN

<06-8 특정 폴더 내, 모든 엑셀 파일의 이름 가져오기>

   Dim PN As String

   Dim FN As String

   PN = Environ(“userprofile”) & “\Desktop\Test\”

   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”) & “\Desktop\Test\”

   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”) & “\Desktop\Test\Test.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”) & “\Desktop\VBA_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

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.

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”) & “\Desktop\Test\test.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”) & “\Desktop\Test” 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”) & “\Desktop\Test”

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”) & “\Desktop\Test\”, 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”) & “\Desktop\Test\” 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”) & “\Desktop\Test\”

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”) & “\Desktop\Test\” FN = Dir(PN & “*.xls*”)

MsgBox FN

06-8 특정 폴더 내 , 모든 엑셀 파일의 이름 가져오기 ★

Dim PN As String Dim FN As String

PN = Environ(“userprofile”) & “\Desktop\Test\” 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”) & “\Desktop\Test\” 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”) & “\Desktop\Test\Test.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”) & “\Desktop\VBA_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—————————————————–

 

사용자정의 함수, 숫자만

도구 모음으로 건너뛰기