728x90

application .GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)

- FileFilter : 파일 필터링 조건을 지정하는 문자열, 생략하면 모든 파일 종류를 표시

- FilterIndex : 1부터 FileFilter 에서 지정한 필터 개수까지 기본 파일 필터링 조건의 인덱스 번호를 지정

- Title : 대화 상자의 제목을 지정. 생략하면 대화 상자의 제목은 "열기"로 표기됨

- ButtonText : 매킨토시 전용

- MultiSelect : True 이면 파일을 여러개 선택 가능, False 이면 1개만 선택 가능, 생략하면 False


GetOpenFilename 메서드를 이용해서 표준 열기 대화상자를 실행하면 항상 마지막으로 선택했던 폴더가 표시된다.


fName = Application.GetOpenFilename(Title:="엑셀파일열기", FileFilter:="Excel Files *.xls* (*.xls*),")

fNames = Application.GetOpenFilename(MultiSelect:=True)

fNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)

fNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Choose Files", MultiSelect:=True)


ThisWorkbook.Path    '// 현재 폴더의 경로

FileFilter 를 열어서 여러개 지정하려면, "MS-Word, *.doc, Text Files, *.txt" 와 같은 형태로 하면 된다.

파일을 1개만 선택하게 하려면, MultiSelect:=False 로 설정한다.


Sub MultiFiles()
    Dim fNames As Variant
    Dim Msg As String
    Dim i As Long
   
    fNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    On Error Resume Next
    If TypeName(fNames) = "Boolean" Then Exit Sub   

     '// 취소 선택 시 매크로 종료, 변수를 Variant 아닌 String 으로 하면 에러가 발생됨
    If IsArray(fNames) Then

        Msg = "You selected:" & vbNewLine
        For i = LBound(fNames) To UBound(fNames)
            Msg = Msg & fNames(i) & vbNewLine
        Next i
        MsgBox Msg
    End If
End Sub




파일을 열고자 한다면

Workbooks.Open FileName:=fName


Sub Open_FileDialog()
    Dim fName As Variant
    '// 하나의 필터 규칙에 여러 개의 파일 형식을 포함하고자 할 경우에는 세미콜론(;) 을 사용
    fName = Application.GetOpenFilename(FileFilter:="Text Files, *.txt ; *.smi ; *.srt", MultiSelect:=False)
    If TypeName(fName) = "Boolean" Then
        Exit Sub    '// 취소 선택 시 매크로 종료
    Else
        Shell "Notepad.exe " & fName
    End If
End Sub


연습하면서 사용했던 파일


fileToOpen.xlsm


블로그 이미지

Link2Me

,
728x90

출처 : https://support.microsoft.com/en-us/kb/146864


The following table contains a list of the trappable error codes you may encounter when you use the Err function.

   Error code   Error message
   ----------   -------------
   3            Return without GoSub
   5            Invalid procedure call
   6            Overflow
   7            Out of memory
   9            Subscript out of range
   10           Duplicate definition (versions 5.0 and 7.0)
   10           This array is fixed or temporarily locked (version97)
   11           Division by zero
   13           Type mismatch
   14           Out of string space
   16           String formula too complex (versions 5.0 and 7.0)
   16           Expression too complex (version 97)
   17           Can't perform requested operation
   18           User interrupt occurred
   20           Resume without error
   28           Out of stack space
   35           Sub or function not defined (versions 5.0 and 7.0)
   35           Sub, function, or property not defined (version 97)
   47           Too many DLL application clients (version 97)
   48           Error in loading DLL
   49           Bad DLL calling convention
   51           Internal error
   52           Bad file name or number
   53           File not found
   54           Bad file mode
   55           File already open
   57           Device I/O error
   58           File already exists
   59           Bad record length
   61           Disk full
   62           Input past end of line
   63           Bad record number
   67           Too many files
   68           Device unavailable
   70           Permission denied
   71           Disk not ready
   74           Can't rename with different drive
   75           Path/File access error
   76           Path not found
   91           Object variable not set (versions 5.0 and 7.0)
   91           Object variable or With block variable not set
                (version 97)
   92           For Loop not initialized
   93           Invalid pattern string
   94           Invalid use of Null
   95           User-defined error (versions 5.0 and 7.0 only)
   298          System DLL could not be loaded (version 97)
   320          Can't use character device names in specified file names
                (version 97)
   321          Invalid file format (version 97)
   322          Can't create necessary temporary file (version 97)
   323          Can't load module; invalid format (versions 5.0 and 7.0)
   325          Invalid format in resource file (version 97)
   327          Data value named was not found (version 97)
   328          Illegal parameter; can't write arrays (version 97)
   335          Could not access system registry (version 97)
   336          ActiveX component not correctly registered (version 97)
   337          ActiveX component not found (version 97)
   338          ActiveX component did not correctly run (version 97)
   360          Object already loaded (version 97)
   361          Can't load or unload this object (version 97)
   363          Specified ActiveX control not found (version 97)
   364          Object was unloaded (version 97)
   365          Unable to unload within this context (version 97)
   368          The specified file is out of date. This program requires
                a newer version (version 97)
   371          The specified object can't be used as an owner form for
                Show (version 97)
   380          Invalid property value (version 97)
   381          Invalid property-array index (version 97)
   382          Property Set can't be executed at run time (version 97)
   383          Property Set can't be used with a read-only property
                (version 97)
   385          Need property-array index (version 97)
   387          Property Set not permitted (version 97)
   393          Property Get can't be executed at run time (version 97)
   394          Property Get can't be executed on write-only property
                (version 97)
   400          Form already displayed; can't show modally (version 97)
   402          Code must close topmost modal form first (version 97)
   419          Permission to use object denied (version 97)
   422          Property not found (version 97)
   423          Property or method not found
   424          Object required
   425          Invalid object use (version 97)
   429          ActiveX component can't create object or return
                reference to this object (version 97)
   430          Class doesn't support OLE Automation
   430          Class doesn't support Automation (version 97)
   432          File name or class name not found during Automation
                operation (version 97)

   438          Object doesn't support this property or method
   440          OLE Automation error
   440          Automation error (version 97)
   442          Connection to type library or object library for remote
                process has been lost (version 97)
   443          Automation object doesn't have a default value
                (version 97)
   445          Object doesn't support this action
   446          Object doesn't support named arguments
   447          Object doesn't support current locale settings
   448          Named argument not found
   449          Argument not optional
   449          Argument not optional or invalid property assignment
                (version 97)
   450          Wrong number of arguments
   450          Wrong number of arguments or invalid property assignment
                (version 97)
   451          Object not a collection
   452          Invalid ordinal
   453          Specified DLL function not found
   454          Code resource not found
   455          Code resource lock error
   457          This key is already associated with an element of this
                collection (version 97)
   458          Variable uses a type not supported in Visual Basic
                (version 97)
   459          This component doesn't support events (version 97)
   460          Invalid clipboard format (version 97)
   461          Specified format doesn't match format of data
                (version 97)
   480          Can't create AutoRedraw image (version 97)
   481          Invalid picture (version 97)
   482          Printer error (version 97)
   483          Printer driver does not support specified property
                (version 97)
   484          Problem getting printer information from the system.
                Make sure the printer is set up correctly (version 97)
   485          Invalid picture type (version 97)
   486          Can't print form image to this type of printer
                (version 97)
   735          Can't save file to Temp directory (version 97)
   744          Search text not found (version 97)
   746          Replacements too long (version 97)
   1000         Classname does not have propertyname property
                (versions 5.0 and 7.0)
   1001         Classname does not have methodname method
                (versions 5.0 and 7.0)
   1002         Missing required argument argumentname
                (versions 5.0 and 7.0)
   1003         Invalid number of arguments (versions 5.0 and 7.0)
   1004         Methodname method of classname class failed
                (versions 5.0 and 7.0)
   1005         Unable to set the propertyname property of the classname
                class (versions 5.0 and 7.0)
   1006         Unable to get the propertyname property of the classname

                class (versions 5.0 and 7.0)
   31001        Out of memory (version 97)
   31004        No object (version 97)
   31018        Class is not set (version 97)
   31027        Unable to activate object (version 97)
   31032        Unable to create embedded object (version 97)
   31036        Error saving to file (version 97)
   31037        Error loading from file (version 97)
				


블로그 이미지

Link2Me

,
728x90

날짜를 표시하는 VBA 코드다.

/ 는 Split 함수를 이용하여 배열로 저장하면 간단하게 해결할 수 있다. 함수식을 사용하면 계산이 좀 더 복잡해진다.

DateSerial(year, month, day) 를 이용하여 날짜를 표시한다.

그리고 NumberFormat 으로 서식을 지정해줘야 깔끔하게 정리가 된다.

Resize 기능을 이해하려면 아래 코드를 한줄씩 실행해보면 선택영역이 어떻게 변경되는지 확인할 수 있다.

Sub resize_func()
    Range("A3:A5").Offset(, 1).Resize(, 3).Select
    Range("A3").Resize(RowSize:=2, ColumnSize:=2).Select
    Range("A3").Resize(2).Select
    Range("A3").Resize(, 2).Select
    Range("A3:A5").Resize(, 2).Select
End Sub


Sub date_extract()
    Dim v
    Dim rngC As Range
    Dim rngAll As Range
  
    Set rngAll = Range([A3], Cells(Rows.Count, "A").End(3))
    For Each rngC In rngAll     '// A열의 마지막 데이터가 있는 곳까지
        v = Split(rngC, "/")    '// A열의 셀을 / 로 구분하여 배열로 저장
        rngC.Offset(0, 1) = v(2)
        rngC.Offset(0, 2) = v(0)
        rngC.Offset(0, 3) = v(1)
        rngC.Offset(0, 4) = DateSerial(v(2), v(0), v(1))
    Next rngC
    rngAll.Offset(, 1).Resize(, 3).NumberFormat = "General"
    rngAll.Offset(, 4).NumberFormat = "yyyy-mm-dd"
    Set rngAll = Nothing
    MsgBox "작업완료"
End Sub

블로그 이미지

Link2Me

,
728x90

수정을 하거나 중간 중간 확인을 해야 하는 상황일 때에는 시작행, 마지막행을 가변적으로 지정할 필요가 있다.

이때에는 코드를 아래처럼 만들어서 사용하면 좀 더 편하고 좋다.

VBA 도 조금 알게 되니까 범위지정을 얼마나 편리하게 할 것인가, 간단간단한 팁을 알아두면 여러모로 유용하게 사용할 수가 있는 거 같다.


    Dim C, rngAll As Range
    Dim sRow    '// 시작할 행의 변수
    Dim v
    Application.StatusBar = True
    v = InputBox("시작할 행의 수를 입력하세요")
    sRow = Trim(Split(v, "/")(0))
    If sRow = vbNullString Then Exit Sub           '// 취소 선택시 매크로 중단
    If Not IsNumeric(sRow) Then Exit Sub         '// 입력한 값이 숫자가 아닌 경우 매크로 중단
       
    If InStr(v, "/") > 0 Then
        eRow = Trim(Split(v, "/")(1))  '// 마지막 행
    End If
    Debug.Print "Last Row : " & eRow
    If eRow Then
        Set rngAll = Range(Cells(sRow, "G"), Cells(eRow, "G"))
    Else
        Set rngAll = Range(Cells(sRow, "G"), Cells(Rows.Count, "G").End(3))
    End If

블로그 이미지

Link2Me

,
728x90

위키피디아(http://en.wikipedia.org/wiki/ASCII)에 아스키 코드값이 나온 자료가 있어서 가져왔다.

2진수, 8진수, 10진수, Hex 값이 같이 나와서 값을 찾아볼 때 매우 편리할 거 같다.


Binary Oct Dec Hex Glyph
010 0000 040 32 20 (space)
010 0001 041 33 21 !
010 0010 042 34 22 "
010 0011 043 35 23 #
010 0100 044 36 24 $
010 0101 045 37 25 %
010 0110 046 38 26 &
010 0111 047 39 27 '
010 1000 050 40 28 (
010 1001 051 41 29 )
010 1010 052 42 2A *
010 1011 053 43 2B +
010 1100 054 44 2C ,
010 1101 055 45 2D -
010 1110 056 46 2E .
010 1111 057 47 2F /
011 0000 060 48 30 0
011 0001 061 49 31 1
011 0010 062 50 32 2
011 0011 063 51 33 3
011 0100 064 52 34 4
011 0101 065 53 35 5
011 0110 066 54 36 6
011 0111 067 55 37 7
011 1000 070 56 38 8
011 1001 071 57 39 9
011 1010 072 58 3A :
011 1011 073 59 3B ;
011 1100 074 60 3C <
011 1101 075 61 3D =
011 1110 076 62 3E >
011 1111 077 63 3F ?
Binary Oct Dec Hex Glyph
100 0000 100 64 40 @
100 0001 101 65 41 A
100 0010 102 66 42 B
100 0011 103 67 43 C
100 0100 104 68 44 D
100 0101 105 69 45 E
100 0110 106 70 46 F
100 0111 107 71 47 G
100 1000 110 72 48 H
100 1001 111 73 49 I
100 1010 112 74 4A J
100 1011 113 75 4B K
100 1100 114 76 4C L
100 1101 115 77 4D M
100 1110 116 78 4E N
100 1111 117 79 4F O
101 0000 120 80 50 P
101 0001 121 81 51 Q
101 0010 122 82 52 R
101 0011 123 83 53 S
101 0100 124 84 54 T
101 0101 125 85 55 U
101 0110 126 86 56 V
101 0111 127 87 57 W
101 1000 130 88 58 X
101 1001 131 89 59 Y
101 1010 132 90 5A Z
101 1011 133 91 5B [
101 1100 134 92 5C \
101 1101 135 93 5D ]
101 1110 136 94 5E ^
101 1111 137 95 5F _
Binary Oct Dec Hex Glyph
110 0000 140 96 60 `
110 0001 141 97 61 a
110 0010 142 98 62 b
110 0011 143 99 63 c
110 0100 144 100 64 d
110 0101 145 101 65 e
110 0110 146 102 66 f
110 0111 147 103 67 g
110 1000 150 104 68 h
110 1001 151 105 69 i
110 1010 152 106 6A j
110 1011 153 107 6B k
110 1100 154 108 6C l
110 1101 155 109 6D m
110 1110 156 110 6E n
110 1111 157 111 6F o
111 0000 160 112 70 p
111 0001 161 113 71 q
111 0010 162 114 72 r
111 0011 163 115 73 s
111 0100 164 116 74 t
111 0101 165 117 75 u
111 0110 166 118 76 v
111 0111 167 119 77 w
111 1000 170 120 78 x
111 1001 171 121 79 y
111 1010 172 122 7A z
111 1011 173 123 7B {
111 1100 174 124 7C |
111 1101 175 125 7D }
111 1110 176 126 7E ~


블로그 이미지

Link2Me

,
728x90

아직도 범위 지정을 신경쓰지 않고 한방에 훅하고 해결을 못하고 있다.

Sheet 와 Sheet 간에 데이터를 복사하거나 참조하여 계산하거나 할 때 셀의 구간범위 지정하는 것 때문에 신경쓰는 일이 없도록 샘플을 만들었다.

Range 를 단순하게 설정하는 것은 아주 쉽고 엄청많다. 하지만 Sheet 가 서로 다를 때 구간설정하는 것을 조금이라도 실수를 하면 에러가 발생하는 걸 몇차례 경험했다.

엑셀 VBA 를 조금씩 배워가면서 터특한 것을 중심으로 더 나은 VBA 코드로 만들 수 있는 것은 재정리를 하거나 삭제를 해둬야겠다. 막상 참고해서 뭘 좀 하려고 하면 별 도움이 안되는 것도 눈에 보인다.

범위설정을 다음부터는 신경쓰지 않고 한번에 해결하기 위해서 기록해둔다.


range_setting.vbs


Sub 구간범위지정()
    Dim sht1, sht2     As Worksheet   '// 시트(Sheet)를 넣을 변수
    Dim rngDB, rngAll As Range
    Dim rngT, rngC As Range
    Dim i&, n&, startRow, endRow As Long   '// 오버플로우를 경험후 무조건 Long 으로 설정
     Dim openMsg As String
   

    Application.StatusBar = True   


    openMsg = "시작행을 입력하는 방식이면 Yes를 눌러주세요 " & vbCr & vbCr
    openMsg = openMsg & "기본 시작행을 선택하려면 No를 눌러주세요" & vbCr
    If MsgBox(openMsg, vbYesNo) = vbYes Then
        startRow = InputBox("시작할 행의 수를 입력하세요")
        If startRow = vbNullString Then Exit Sub           '// 취소 선택시 매크로 중단
    Else
        startRow = 2    '// 시작행 지정
    End If   
    If Not IsNumeric(startRow) Then Exit Sub     '// 입력한 값이 숫자가 아닌 경우 매크로 중단
   
    Set sht1 = Sheets("data")   '// data 워크시트를 sht1 으로 지정
    Set sht2 = Sheets("category") '// category 워크시트를 sht2 로 지정
    Set rngAll = sht1.Range(sht1.Cells(startRow, "D"), sht1.Cells(Rows.Count, "D").End(3))
    Set rngDB = sht2.Range(sht2.Cells(2, "C"), sht2.Cells(Rows.Count, "C").End(3))
    endRow = sht1.Cells(Rows.Count, "D").End(3).Row    '// D열의 값이 있는 마지막셀의 행번호


    실제 계산을 위한 코딩

    결과가 끝났음을 알려주는 Msgbox 처리


End sub


계속 코드를 만들어서 사용하다보니 이것도 좀 불편하다.

그래서 새롭게 정리해서 사용하는 코드는 아래와 같다.

물론 위의 코드와 사용하는 용도는 약간 다르지만 sRow, eRow 를 Selection 개념이랑 같이 적용하여 편리하다.


    Dim C, rngAll As Range
    Dim sRow, eRow As Long    '// 시작할 행의 변수
    Dim cnt%
    Dim myValue As String
    Dim v
   
    Application.DisplayStatusBar = True
    cnt = Selection.Rows.Count
    sRow = Selection.Row
    myValue = sRow & "/" & sRow + cnt - 1
    v = InputBox("시작할 행의 수를 입력하세요", , myValue)
    If InStr(v, "/") > 0 Then
        sRow = Trim(Split(v, "/")(0))
        eRow = Trim(Split(v, "/")(1))  '// 마지막 행
    Else
        sRow = v
    End If
    If sRow = vbNullString Then Exit Sub           '// 취소 선택시 매크로 중단
    If sRow <= 2 Then sRow = 2
    If Not IsNumeric(sRow) Then Exit Sub '// 입력한 값이 숫자가 아닌 경우 매크로 중단
   
    If eRow Then
        Set rngAll = Range(Cells(sRow, "A"), Cells(eRow, "A"))  '// 열의 끝행을 지정
    Else
        Set rngAll = Range(Cells(sRow, "A"), Cells(Rows.Count, "A").End(3))
    End If


블로그 이미지

Link2Me

,
728x90

인터넷에서 자료를 찾다보면 번호가 나오고 뒤에 내용이 나오는 경우가 있습니다.

이럴 경우 번호를 일일이 지우려고 하니까 좀 짜증나더군요.


그래서 간단하게 만들어본 VBA 코드입니다.


Sub 앞번호제거()
    Dim rngC As Range
    Dim rngAll As Range
   
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
   
    For Each rngC In rngAll
        If IsNumeric(Left(rngC, 1)) Then
            rngC.Offset(, 1) = Trim(Mid(rngC, Len(Split(rngC, ".")(0)) + 2, Len(rngC)))
        Else
            rngC.Offset(, 1) = rngC
        End If
    Next rngC
   
End Sub

블로그 이미지

Link2Me

,
728x90

엑셀에서 수식의 결과를 구하고 나면 깔끔한 선그리기로 모양을 예쁘게 하고 싶을 경우가 있습니다.



borders.xlsm


Sub 테두리선그리기()
    Dim rngAll As Range
   
    Set rngAll = Range([B2], [E10]) '// 선그릴 구간범위 지정
   
    Range([A1], Cells(Rows.Count, "K")).Borders.LineStyle = xlLineStyleNone
    '// A1 에서 K열의 마지막행까지의 선을 그리지 말아라, 즉 선을 모두 지워라
   
    With rngAll.Borders    '// 구간범위의 선(Borders) 그리기
        .LineStyle = 1        '// 실선(xlContinuous)으로 그려라
        .ColorIndex = 14    '// 색상은 http://link2me.tistory.com/260 참조
        .Weight = xlThin    '// xlThin : 가는 실선, xlThick : 굵은 실선
    End With
   
    rngAll.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=22
    '// 외곽선 그리기
End Sub


LineStyle 은

xlContinuous (실선), xlDash (파선), xlDashDot (파선과 점선이 교대로 나타나는 형태), xlDashDotDot (파선과 두개의 점선이 교대로 나타나는 형태), xlDot (점선), xlDouble (이중선), xlLineStyleNone (선 없음), xlSlantDshDot (기울어진 파선)


Weight 는

xlHairline (가장 가는 실선), xlThin (가는 실선), xlMedium (보통굵기의 선), xlThick (굵은 실선)


* 가장 가는 실선(xlHairline) 으로 지정하면 거의 점선처럼 보인다.

* LineStyle 을 지정하지 않고 테스트해보면 된다.


ColorIndex : 테두리 선의 색상을 색 번호 또는 내장 상수를 이용해서 지정

xlColorIndexAutomatic (자동 색상), xlColorIndexNone (색상을 적용하지 않음)

ColorIndex 색상의 숫자에 따른 색깔이 어떻게 표시되는지 확인하려면 http://link2me.tistory.com/260

을 참조하세요


블로그 이미지

Link2Me

,
728x90

네이버 지식인에 올라온 문의사항이 의미하는 바를 모르겠다고 하여 주석문을 달았습니다.

F8 키를 눌러서 한줄 한줄 내려가면서 육안으로 값을 확인해 보면 내용 이해에 도움이 됩니다.

Target.Find(What:=FindCell, Lookat:=xlWhole)

Target 은 찾아야 할 셀의 범위를 지정

FindCell 은 찾을 셀

LookAt:=xlPart 는 부분적으로 일치하는 것을 찾을 때

LookAt:=xlWhole 은 전부 일치하는 경우


Find 함수를 사용할 경우 이중 For 문을 사용하는 경우와

For 문을 하나만 쓰고 Do Loop Whle 문을 쓰는 경우 속도 차이가 상당히 많이 납니다.





Debug.Print 를 하면 직접실행창(Ctrl + 5) 에 아래처럼 나옵니다.

Msgbox 를 하면 매번 팝업창으로 뜨는 불편함이 있지만, Debug.Print 를 하면 VBA 코드에 대한 이해도 쉽고, 내용 파악에도 도움이 많이 됩니다.


Sub FindData()
    Dim sht1     As Worksheet   '// 시트(Sheet)를 넣을 변수
    Dim sht2      As Worksheet  '// 시트(Sheet)를 넣을 변수
    Dim strAddr As String       '// 주소를 저장할 변수
    Dim C       As Range        '// 영역변수
    Dim iRow    As Long        '// 행의 마지막 값을 저장할 변수
    Dim n       As Long          '// 행을 증가시킬 변수
   
    Set sht1 = Sheets("성적")   '// 성적 워크시트를 sht1 으로 지정
    Set sht2 = Sheets("연도별") '// 연도별 워크시트를 sht2 로 지정
    sht1.Range([E1], Cells(Rows.Count, "E").End(xlUp)).Offset(1).ClearContents
    '// 성적 시트의 E1 셀을 제외하고 전부 값을 지워라
    iRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row    '// A열의 값이 있는 마지막셀의 행번호
    For n = 2 To iRow
        Set C = sht2.Columns(1).Find(sht1.Cells(n, 1).Value, Lookat:=xlWhole)

  '// 찾을 범위(Range)는 sht2.Columns(1)

        '// sh2.Columns(1) 범위에서 sht1.Cells(n,1).Value 과 100% 일치하는 값을 찾아 C에 넣는다
        '// Cells(행,열) 이므로 Cells(n,1) 은 A열에서 행번호는 변하는 값

        Debug.Print "주소 : " & Cells(n, "A").Address & " 값 : " & Cells(n, "A").Value       
        If Not C Is Nothing Then    '// C 에 값이 할당되어 있으면(찾는 값이 있으면)
            strAddr = C.Address     '// sh2의 C의 처음 셀주소를 strAddr 에 저장
            Do
           
Debug.Print C.Next.Value    '// C.Next.Value 의 값을 확인해보기 위해서
                If C.Next.Value = sht1.Cells(n, 2).Value Then   '// C.Next.Value 는 C의 다음셀의 값
                    sht1.Cells(n, 5).Value = C.Offset(0, 2).Value   '// C의 값이 들어 있는 셀로부터 우측으로 2번째 값
                    Exit Do     '// Do Loop 문을 빠져나가라
                End If
                Set C = sht2.Columns(1).FindNext(C) '// sht2 시트의 A열의 다음(아래행)을 C에 저장하라
               
Debug.Print "C의 값은 " & C & " C의 주소는 " & C.Address
            Loop While Not C Is Nothing And C.Address <> strAddr
            '// C 에 값이 할당되어 있고 C.address 와 strAddr 이 서로 다르면 DO문 처음으로 이동
        End If
    Next n  '// 순차적으로 행을 하나씩 증가시킴
    MsgBox "작업완료"
End Sub



FindVBA_예제.xlsm


블로그 이미지

Link2Me

,
728x90

엑셀 VBA 를 배우는 초보단계에서는 개념 이해가 매우 중요합니다.


Sub 행삭제()
    Dim r, i As Double
    Dim LastRow As Double
   
    LastRow = Cells(Rows.Count, "F").End(3).Row
    For r = LastRow To 1 Step -1
        If Cells(r, "F") = 1 Then
            Rows(r).Delete
            i = i + 1
        End If
    Next r
    MsgBox i & "개 삭제"
End Sub


개념 이해를 하려면 아래처럼 화면을 구성하는 것이 좋습니다.

하단에는 지역창을 띄워놓고 F8 키를 눌러서 한줄 한줄 내려가면서 값이 어떻게 변경되는지 눈으로 확인하면 코드 이해가 좀 더 쉽습니다.


코드 설명

Option Explicit
를 선언해서 VBA 코드에 변수선언이 안된 변수가 있는지 점검하는 것이 에러를 없을 수 있습니다.

Cells(행, 열) 의 개념만 이해하면 됩니다.
Cells(2,2) 는 B2셀을 의미하겠죠.
Cells(2,"F") 는 F2셀을 의미합니다.
엑셀을 다루다보면 마지막 행을 찾아서 직접 적어주는 방식보다는
컴퓨터가 알아서 마지막 행을 자동 인식하도록 설정하는 것이 편합니다.
Cells(Rows.Count,"F") 가 의미하는 것은 F열의 Rows.Count (엑셀에서 제공하는 마지막행) 을 의미합니다.
Cells(Rows.Count, "F").End(3) 이 의미하는 것은 F열의 Rows.Count 로부터 End(3) 또는 End(xlUp) 위로 이동하여 데이터가 들어있는 마지막 행을 찾아라 입니다.
Cells(Rows.Count, "F").End(3).Row 는 마지막 셀이 들어 있는 행의 값을 의미합니다.

행을 삭제할 때에는 반드시 밑에서 부터 삭제를 해야 문제가 생기지 않습니다.
For Next 문에서 

    For r = LastRow To 1 Step -1
        If Cells(r, "F") = 1 Then
            Rows(r).Delete
            i = i + 1
        End If
    Next r

시작은 마지막행번호, 마지막 행은 데이터가 들어있는 마지막번호, Step 은 1씩 감소

For 문은 시작행부터 마지막행가지 반복수행하라는 것이고요.

IF문은 For 문을 반복 수행하다가 조건에 맞는 것이 있으면 그 부분을 실행하라는 것입니다.


변수 선언은 각자의 취향입니다만 가능하면 약어로 행인지 열인지 얼른 파악할 수 있는 걸로 정하면 더 좋을 거 같습니다.

저는 행을 i 로 선언하기도 하는 경우도 있고요. r 로 선언하는 경우도 있습니다.

r 로 하면 row(행)의 약자로 이해하기가 더 쉬울 수 있겠죠.


VBA 에서 코드 짜는 것은 알고 보면 정말 쉬운 겁니다.

다만, 핵심 코드를 짜는 로직은 쉬운데, 엑셀 VBA 가 제공하는 기본 명령어를 알아야 합니다.

그걸 바로 바로 알아서 적용하면 좋은데 그건 시간을 가지고 배우는 수 밖에는 없습니다.


블로그 이미지

Link2Me

,
728x90

엑셀 워크시트를 숨기기를 하는 방법입니다.

워크시트 개체의 속성중에는 Visible이 있습니다. 이 속성은 워크시트를 보이거나 숨기는 역할을 합니다. 

Visible속성에는 xlSheetVisibility의 열거형 상수값으로 xlSheetHidden, xlSheetVeryHidden, xlSheetVisible중 하나를 사용할 수 있습니다.



시트를 숨기기 할 때는 Sheet.Name 이 아니라 앞에 보이는 Sheet2 입니다.

VeryHidden 을 적용하면 시트자체가 있는지 조차도 모릅니다.


시트를 숨기기를 하려면 VBA 코드도 볼 수 없도록 암호를 걸어두는 것이 좋습니다.



블로그 이미지

Link2Me

,
728x90

중복 데이터가 입력되었을 때 중복된 데이터를 제거하고 고유한 항목만 뽑아내고 싶을 때가 있습니다.

Array를 사용하면 여러개의 조건이 일치하는 것만 찾아서 중복 제거를 할 수도 있습니다.

RemoveDuplicates 를 사용하면 되는데

Range.RemoveDuplicates Colums, Header 로 되어 있습니다.

Header:=xlNo (열 머리글이 존재하지 않음)

Header:=xlYes (열 머리글이 존재)


Columns : 중복된 정보가 들어있는 열 인덱스의 배열. 열을 지정하지 않으면 모든 열에 중복된 정보가 있는 것으로 간주

ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=Array(1,2), Header:=xlYes
또는 간략하게
ActiveSheet.Range("A1:C100").RemoveDuplicates Array(1,2), xlYes
로 사용해도 됩니다.


Sub 중복데이터제거()
    Range("A1:C" & Cells(Rows.Count, "A").End(3).Row).RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes

    '// A1:C의 데이타가 있는 마지막열 구간범위내에서 2열, 3열 기준으로 중복된 것을 제거하라. 헤더는 포함

  
    '// 2번째 열 기준으로 중복제거
    'Range("A1:C100").RemoveDuplicates Columns:=2, Header:=xlYes
   
    '// 3번째 열 기준으로 중복제거
    'Range("A1:C100").RemoveDuplicates Columns:=3, Header:=xlYes
End Sub

블로그 이미지

Link2Me

,
728x90

Ralace 이용해서 값 찾아 변경하기



현재 시트에서 원하는 값을 찾아서 변경하는 VBA 코드입니다.



문자열을 찾아서 변경할 때에는 찾는 문자열은 있는데, 변경할 문자열은 공백인 경우도 있습니다.

그리고 찾는 문자열과 변경할 문자열이 맞는지 확인하는 것도 필요합니다.

IF 함수와 Msgbox 확인을 통해서 조건에 맞으면 진행하고 조건에 맞지 않으면 취소하는 로직도 고려했습니다.

첨부된 엑셀에서 Alt + F11 을 누르고 [모듈] Module2 를 선택하면 코드가 나옵니다.

Replace 를 블럭 설정한 다음 F1 (도움말) 키를 누르면 함수에 대한 설명이 나옵니다.


특정한 열을 기준으로 찾고자 한다면 For Each sht In ThisWorkbook.Worksheets .... Next sht 문 대신에

한줄로

Range([C2], Cells(Rows.Count, "C").End(3)).Replace What:=FindText, Replacement:=replace_Text


Sub replace_Text()
    Dim sht As Worksheet
    Dim FindText  As String
    Dim replace_Text As String   
       
    FindText = InputBox("찾을 문자열 입력") '//찾을 문자열을 변수에 넣음
    If FindText = "" Then Exit Sub
   
    replace_Text = InputBox("[" & FindText & "] 을 바꿀 문자열을 입력하세요")
    If replace_Text = "" Then
        If MsgBox("바꿀 내용이 공백이면 찾을 내용을 삭제합니다" & vbCr & "수정하시겠습니까?", vbYesNo) = vbNo Then Exit Sub
    Else
        If MsgBox("찾을 내용 : " & FindText & vbCr & "바꿀 내용 : " & replace_Text & vbCr & "변경하시겠습니까?", vbYesNo) = vbNo Then Exit Sub
    End If
   
    For Each sht In ThisWorkbook.Worksheets
        sht.Cells.Replace What:=FindText, Replacement:=replace_Text
    Next sht
   
    MsgBox "변경완료 했습니다"
End Sub


replace_VBA_samples.xlsm





블로그 이미지

Link2Me

,
728x90

엑셀 특정 시트만 제외하고 모든 시트 삭제



엑셀 특정 시트만 남기고 다른 모든 시트를 삭제하는 VBA 코드 입니다.

먼저 엑셀화면과 VBA 코드를 입력하는 화면에서 표시되는 부분을 보는 것이 이해하는데 빠릅니다.

시트(Sheet) 이름이 VBA 입력창에서는 어떻게 표시되는지 보이시죠?

시트명은 괄호로 표시되고 있는 걸 알 수 있습니다.

아래와 같은 화면이 나오도록 하려면 Alt + F11 키를 누릅니다.




Sheet1 시트만 남기고 모드 삭제하는 것은 

현재 엑셀파일(ThisWorkbook)의 모든 시트(Worksheets)를 범위로 지정하고 각 시트(sht)를 순환하면서

sht.Name 이 Sheet1 이 아니면 지우라고 코드를 만듭니다.


sheet_delete.vbs

첨부파일은 아래 코드를 그대로 넣은 텍스트 파일이며, 필요하면 다운로드하여 파일열고 복사하여 붙여넣기 하면 하세요.


Sub sheet_delete()
    Dim sht As Worksheet
   
    Application.DisplayAlerts = False   '// 엑셀 화면 경고표시 중단   
    For Each sht In ThisWorkbook.Worksheets  '// 파일의 각 시트 순환
        If sht.Name <> "Sheet1" Then               '// Sheet 파일이름이 Main이 아니면
            sht.Delete                               '// 시트 삭제
        End If
    Next sht   
    Application.DisplayAlerts = True   '// 화면 경고표시 복원
End Sub


이 코드를 실행하려면 커서를 Sub sheet_delete() 코드내 아무곳에나 위치하고 F5 키를 누릅니다.



위 그림에서 하단에 보면 Sheet1 만 남기고 전부 지워진거 보이죠?

블로그 이미지

Link2Me

,
728x90

Sub RGB색상채우기()
Dim rngC As Range

For Each rngC In Range("A2:A16913").SpecialCells(2)
    rngC.Offset(, 3).Interior.Color = RGB(rngC.Value, rngC.Offset(, 1).Value, rngC.Offset(, 2).Value)
Next rngC

End Sub


RGB 색상을 어떤 색으로 적용하면 좋을지 쉽게 찾을 수가 없어서 RGB 표를 만들었습니다.

RGB 색을 변경해서 육안으로 쉽게 원하는 색을 찾아서 적용하기 쉽게 했습니다.




RGB색상표.xlsm


첨부파일 받아서 직접 보시면 활용하는데 도움 되실 겁니다.

첨부파일 실행하고 Alt + F11 눌러서 보면 아래와 같은 형태의 화면이 나옵니다.

해당 Sheet 에 코드가 적용된 것인지를 알고자 한다면 해당 시트를 선택하고 마우스 우클릭하여 코드보기를 누르면 보입니다.



블로그 이미지

Link2Me

,
728x90

250 부터 650개씩 10씩 숫자가 줄어들게 채우는 VBA 코드입니다.

이 코드는 RGB 색상표를 만들기 위해 작성한 것인데 기본 숫자를 다루는 겁니다.

변수 선언을 Integer 로 하면 메모리 크기가 2byte 로 값은 -32,768 ~ 32,767 입니다.

Range 범위가 Integer 범위를 넘어가면 Long(4byte), Singe(8byte), Double(8byte) 로 선언해야 합니다.


Sub 숫자채우기()
    Dim rngC As Range
    Dim i As Integer
    Dim Temp As Integer
           
    Temp = 250
    For Each rngC In Range("A655:A17000")  '// Range 범위구간동안 rngC (각 셀)을 순환
        If rngC.Offset(-1, 0) = Temp Then  '// 상위 셀과 Temp 값이 서로 같으면
            rngC = Temp     '// Temp 값을 현재 셀에 넣어라
            i = i + 1              '// 몇개를 카운트 한 것인지 알기 위해 숫자를 카운트하라
        End If
        If i = 650 Then       '// i 가 650 이면
            i = 0                '// i 를 초기화하라
            rngC = rngC.Offset(-1, 0) - 10    '// 그리고 상위 셀에서 10을 빼라. 즉 10을 감소하라
            Temp = rngC                                '// Temp 변수에 10을 뺀 값을 넣어라
            If Temp < 0 Then Exit For        '// 만약 Temp 값이 0 보다 작으면 For 문을 빠져나가라
        End If
    Next rngC            '// rngC(현재셀)의 다음셀로 이동해서 For 문을 반복하라

End Sub


Sub B열숫자채우기()
    Dim rngC As Range
    Dim i As Integer
           
    For Each rngC In Range("B6:B16913")
        If rngC.Offset(-1, 0) = 250 Then    '// 각 셀을 반복하다가 상위 셀이 250이면 현재 셀을 0으로 놓아라
            rngC = 0
        Else
            rngC = rngC.Offset(-1, 0) + 10  '// 상위셀에다가 10을 더하여 현재 셀에 넣어라
        End If
    Next rngC
End Sub

Sub C열숫자복사하기()
    Dim rngC As Range
    Dim rngAll As Range

    For Each rngC In Range("C681:C16913")
        Set rngAll = Range("C5:C680")
        rngAll.Copy Cells(Rows.Count, "C").End(3)(2)   '// 범위구간 전체(C5:C680)를 복사하여

                                                                                      '//C열의 값이 들어있는 마지믹 열에 넣어라
    Next rngC

End Sub


블로그 이미지

Link2Me

,
728x90

배열의 이해


엑셀에서 셀에 대한 개념, 범위 설정에 대한 이해를 했다면, 이제 배열 이해를 하면 엑셀 VBA 다루는 것을 훨씬 더 쉽습니다.


컴퓨터(PC)는 크게 나누어 보면 CPU(연산처리장치), 메모리, 하드디스크 로 구분할 수 있다.

엑셀에서 변수를 선언하고, 배열을 선언하고 값을 할당하는 것은 메모리 공간에 할당되는 것이다.

메모리와 하드디스크의 속도차이는 800배 이상의 차이가 난다.

하드디스크와의 입출력을 조금이라도 빠르게 하기 위한 장치가 SSD 이다. SSD는 하드디스크 대비 5 배 이상 빠른 속도를 낼 수 있으나 수명이 하드디스크에 비해 짧다.


배열 타입을 선언하고 배열 값을 할당하면 할당된 값은 메모리 상에 있다.
이걸 엑셀의 셀에다가 표기하려면 Range를 지정하고 배열을 할당하면 된다.

Sub var_array()

    Dim var(1 To 3) As Integer   
    [A1].CurrentRegion.Clear    '// A1셀의 인접영역에 할당된 값을 전부 제거
    Range("A1:F100").Clear      '// A1:F100 영역에 할당된 값을 전부 제거  
    var(1) = 1
    var(2) = 2
    var(3) = 7
    Range("A1:E1") = var
    Range("A3:C5") = var
End Sub


Dim varTemp 또는 Dim varTemp() 라고 선언한 경우
모든 종류의 데이터 타입(Date, Integer, String, Boolean)을 넣을 수 있다
아래와 같이 데이터 타입을 지정하면 그 데이터 타입에 맞는 데이터만 넣을 수 있다.
Dim varTemp() As Date
Dim varTemp() As Integer
Dim varTemp() As String
Dim varTemp() As Boolean


직접 VBA 코드를 입력하고 결과가 화면에 어떻게 뿌려지는지 살펴보자.

선언된 배열의 크기는 3인데, 1번을 보면 Range("A1:E1") 으로 범위는 5개의 셀을 지정했다.

5개의 셀을 지정한 구간에 배열 var를 할당하니 1,2,7 이 가로로 할당되고, D1셀과 E1셀에는 할당할 값이 없어서 #N/A 로 표기된 것을 알 수 있다.

2번을 보면 Range("A3:C5") 로 범위를 3 X 3 으로 셀을 지정했고, 여기에 배열 var를 할당하면 어떤 결과가 나오는가 봤더니 1, 2, 7 이란 값이 동일하게 3번 반복되어 표기된 것을 알 수 있다.

선언된 변수가 Dim var(1 to 3) As Integer 로 1차원 배열이기 때문이다.



여기서 확인할 수 있는 사항은 배열에 할당된 데이터가 가로로 엑셀의 셀에 할당된다는 것이다.

위의 VBA 코드를 직접 실행해보는 방법은

Alt + F11 을 누르고 나서 [삽입] - [모듈] 을 선택하면 위와 같은 화면을 입력할 수 있는 창이 나온다.

VBA 코드를 복사하여 붙여넣기를 하거나 직접 입력해주고 나서 F5키를 누르면 결과가 엑셀화면에 보인다.

코드를 순차적으로 이해하고 싶다면 F8키를 한번씩 눌러주면 변화되는 과정을 살펴볼 수 있다.


이번에는 배열을 죽 나열하지 않고 한줄로 깔끔하게 표현하고 싶다면 어떻게 해야 할까?

array 를 이용하면 된다. 그런데 array 를 사용하려면 변수 선언을 Dim var as Variant 로 해줘야 한다.

Sub var_array2()

    Dim var As Variant   
    [A1].CurrentRegion.Clear    '// A1셀의 인접영역에 할당된 값을 전부 제거
    Range("A1:F100").Clear      '// A1:F100 영역에 할당된 값을 전부 제거   
    var = Array(1, 3, 9)
    Range("A1:E1") = var
    Cells(3, 1).Resize(, 3) = var
    Cells(4, 1).Resize(, UBound(var)) = var
    Cells(6, 1).Resize(, UBound(var) + 1) = var
   
    MsgBox "LBound는 " & LBound(var) & " UBound는 " & UBound(var)   
End Sub

배열이 1차원으로 가로로 저장된다는 것을 알았으니 아래와 같이 Cells(행,열) 즉 한 셀로부터 Resize 범위를 주고 값을 배열을 할당하면 어떻게 되는지 결과를 보면 다음과 같다.



var = Array(1,3,9) 는 var(0), var(1), var(2) 로 배열은 index 가 0 부터 시작된다.

MsgBox "LBound는 " & LBound(var) & " UBound는 " & UBound(var)  로 배열 하한값과 상한값을 확인할 수 있다.

Resize(,3) 은 Resize(1,3) 을 간략하게 표현한 것이다.

Resize(3) 은 Resize(3,1)을 간략하게 표현한 것이므로 Resize 값을 변경해보면 어떤 결과가 나오는지 직접 확인해보면 훨씬 이해가 빠르다.


배열 값이 가로로 뿌려지는데 세로로 뿌리고 싶다면 어떻게 하면 될까?

엑셀에서 기본적으로 제공하는 함수 transpose(var)를 이용해도 되고, For Next 구문을 이용해도 된다.

Sub var_array3()
    Dim var As Variant   
    [A1].CurrentRegion.Clear    '// A1셀의 인접영역에 할당된 값을 전부 제거
    Range("A1:F100").Clear      '// A1:F100 영역에 할당된 값을 전부 제거   
    var = Array(1, 3, 9)
    Cells(3, 1).Resize(3) = Application.Transpose(var)

    Cells(3, 3).Resize(3, 2) = Application.Transpose(var)   
End Sub


어떤 결과가 뿌려지는지 실행해보면 ....


엑셀에서 기본적으로 제공하는 함수를 VBA에서 활용할 때에는 application 을 앞에 붙여주면 된다.


아래는 Cells(행,열) 에서 행의 값이 변하면서 값이 할당되는데 For 문과 LBound, Ubound 를 활용하면 원하는 시작셀부터 값을 뿌릴 수 있다.

Sub var_array4()
    Dim var As Variant
    [A1].CurrentRegion.Clear    '// A1셀의 인접영역에 할당된 값을 전부 제거
    Range("A1:F100").Clear      '// A1:F100 영역에 할당된 값을 전부 제거
    var = Array(1, 3, 9)
    For n = LBound(var) To UBound(var)
        Cells(n + 1, 1) = var(n)
    Next n
End Sub



배열의 데이터를 셀에 뿌리는 걸 해봤다면 이제 거꾸로 셀에 있는 내용을 배열로 저장하는 걸 해보자.


블로그 이미지

Link2Me

,
728x90

엑셀 VBA 에서 셀 지우기를 할 때 VBA 코드를 잘못짜면 본의아닌 데이터도 지워지게 됩니다.


이걸 방지하기 위해 코드를 한 줄 추가했습니다.


Sub CellClear_DataSheet()
    Dim LastRow As Double
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    LastRow = Cells(Rows.Count, "A").End(3).Row
    If LastRow < 3 Then Exit Sub              '// 지운값이 더 작으면 매크로 중단
    Range(Cells(3, "A"), Cells(LastRow, "I")).Clear  '// 지우고자 하는 범위
    Cells(3, "A").Select
End Sub


왜 범위를 이렇게 줬지? 하고 의심을 하시는 분도 있을 겁니다.

이유는 A열은 데이터가 전부 있는데 다른 열은 데이터가 있기도 하고 없기도 합니다.

그럴 경우 범위를 잘못 잡으면 데이터가 제대로 지워지지 않습니다.


블로그 이미지

Link2Me

,
728x90

엑셀 행높이 자동 설정


엑셀에 자료를 입력하고 나서 순서를 정렬해야 할 경우가 있습니다.

이럴 때 자동으로 행높이 정렬를 해두면 편리합니다.


행높이가 일정하게 18로 되어 있는 경우



비고란의 내용이 제대로 보이지 않는데요.

이를 해결하기 위한 방법은

엑셀에서 전체를 선택한 다음에 행과 행 사이에 마우스를 놓고 더블클릭을 합니다.



자동으로 늘어난 것을 볼 수 있습니다.


이걸 VBA 코드를 이용하여 한다고 하면 ....

[ 코드분석 ]

- 구간범위 rngAll 전체의 행높이를 자동으로 설정하면 정상적인 행간격은 16.5로 설정됨

- 행높이가 18보다 작은 셀인 경우에는 18로 설정하도록 반복 처리


Sub RowHeight_autofit()
    Dim rngC, rngAll As Range
   
    Application.ScreenUpdating = False
    Set rngAll = Range("A2:C" & Cells(Rows.Count, "A").End(3).Row)
    rngAll.EntireRow.AutoFit
    For Each rngC In rngAll
        If rngC.RowHeight <= 18 Then
            rngC.RowHeight = 18
        End If
    Next rngC
    Application.ScreenUpdating = True
End Sub

로 해주면 됩니다.


블로그 이미지

Link2Me

,
728x90

텍스트 숫자(문자열 숫자)를 숫자로 일괄 변경 VBA


텍스트로 된 숫자 즉 문자열이 숫자인 경우에 일괄 숫자로 변경하는 VBA 코드입니다.

사용의 편의성을 위해 변경할 범위를 좀 더 편하게 지정하도록 했습니다.

빨간색으로 된 부분만 변경해서 사용하면 됩니다.


Sub TextNumber2Number()

    Dim rngC As Range

    Dim rngAll As Range

    Dim rngCh

    

    Application.ScreenUpdating = False   '// 화면 업데이트 (일시) 중지

    rngCol = "D"                          '// 열지정

    sRow = 2                      '// 데이터 시작행 설정

    Set rngAll = Range(Cells(sRow, rngCol), Cells(Rows.Count, rngCol).End(3))  '// 범위지정

    'Set rngAll = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants) '// 시트 전체 지정


    On Error Resume Next

    For Each rngC In rngAll

        'If IsNumeric(rngC) Then rngC = Val(rngC) '// 에러 발생함

        If IsNumeric(rngC) Then rngC = Format(rngC, "#") '// 정상처리됨

    Next rngC


    Set rngAll = Nothing

    MsgBox "변환완료"

    

End Sub

블로그 이미지

Link2Me

,