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 코드입니다.



weekdayofmaxvalue_vba.xlsm


Option Explicit
Sub weekday_max()
    Dim rngC, rngT As Range
    Dim rngAll, rngDB As Range
    Dim tempMax, tempMin As Double
   
    Set rngAll = Range([F2], Cells(Rows.Count, "F").End(3))
    Set rngDB = Range([C2], Cells(Rows.Count, "C").End(3))
   
    Range([G1], Cells(Rows.Count, "H").End(3)).Offset(1).ClearContents
    '// 요일별 최대값, 최소값 내용 초기화
    tempMin = Application.Max(rngDB)    '// 구간범위내 최대값
   
    For Each rngC In rngAll     '// 월, 화, 수, 목, 금, 토, 일 반복
        For Each rngT In rngDB
            If rngC = rngT.Offset(, 1) Then '// 같은 요일이면
                If rngT > tempMax Then  '// 최대값을 구하라
                    tempMax = rngT
                End If
                If rngT < tempMin Then  '// 최소값을 구하라
                    tempMin = rngT
                End If
            End If
        Next rngT
        rngC.Offset(, 1) = tempMax  '// 셀에 최대값을 저장하라
        rngC.Offset(, 2) = tempMin  '// 셀에 최소값을 저장하라
        tempMax = 0    '// 최대값 초기값 초기화
        tempMin = Application.Max(rngDB)  '// 최소값 초기값 초기화
    Next rngC
End Sub

블로그 이미지

Link2Me

,
728x90

구간범위 내의 행 전체가 비어 있는 경우에만 삭제하고 싶은 경우의 VBA 코드입니다.

항상 삭제를 할 때에는 아래행부터 시작해서 위로 시작한다는 것을 명심하셔야 합니다.




Sub 행전체가빈셀인경우()
    Dim rngDB As Range
    Dim r, LastRow, k As Double
   
    Application.ScreenUpdating = False  '// 화면 업데이트 일시정지
    LastRow = Cells(Rows.Count, "C").End(3).Row  '// 마지막 셀이 있는 행을 찾기 위해서
   
    For r = LastRow To 1 Step -1
        Set rngDB = Range(Cells(r, "A"), Cells(r, "D")) '// 각 행의 D열까지를 범위구간으로 선언
        If Application.WorksheetFunction.CountA(rngDB) = 0 Then  '// 범위구간 전부가 비어 있으면
            Rows(r).EntireRow.Delete   '// 해당 행 전체 삭제
            k = k + 1       '// 삭제되는 행의 숫자를 카운트 하기 위해
        End If
    Next r   
    MsgBox k & "행 삭제완료"
End Sub

그런데 해당행 전체가 아니라 표의 해당구간내의 경우에만 삭제를 하고 싶다면 어떻게 해야 할까요?


Sub 범위구간의빈셀인경우행삭제()
    Dim rngDB As Range
    Dim r, LastRow, k As Double
   
    Application.ScreenUpdating = False  '// 화면 업데이트 일시정지
    LastRow = Cells(Rows.Count, "C").End(3).Row  '// 마지막 셀이 있는 행을 찾기 위해서
   
    For r = LastRow To 1 Step -1
        Set rngDB = Range(Cells(r, "A"), Cells(r, "D")) '// 각 행의 D열까지를 범위구간으로 선언
        If Application.WorksheetFunction.CountA(rngDB) = 0 Then  '// 범위구간 전부가 비어 있으면
            rngDB.Delete   '// 범위구간의 행 전체 삭제
            k = k + 1       '// 삭제되는 행의 숫자를 카운트 하기 위해
        End If
    Next r   
    MsgBox k & "행 삭제완료"
End Sub


위의 코드와 아래 코드 전부 동일한테 적색으로 표시한 부분만 다릅니다.


결과화면은


블로그 이미지

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

다량의 자료를 반복작업을 할 경우, 메모리 크기를 너무 많이 잡으면 오히려 처리가 늦어지게 됩니다.

그래서 적당한 크기로 메모리를 할당하고 반복 작업이 끝나면 메모리 비우는 작업을 한 다음에

반복해서 수행하도록 하면 처리가 빨라집니다.


이중 For 문을 사용하여 안쪽에 있는 For문에서는 SplitLine 만큼 반복해서 수행하도록 합니다.

바깥쪽 For 문에서는 반복할 횟수를 지정합니다.

안쪽 For 문은 실제 원하는 걸 구할 사항을 코딩하는 부분입니다. 즉 가장 핵심적인 사항이죠.

다른 부분은 핵심적인 부분을 얼마나 효율적으로 얻을 수 있게 해주느냐라고 보면 됩니다.


Sub address_merge()
    Dim rngC As Range
    Dim rngAll As Range
    Dim rngDB As Range
    Dim i, k, n As Double
    Dim SplitLine, startRow, LastRow As Double
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    startRow = 2
    SplitLine = 3000
    For n = 1 To (Cells(Rows.Count, "E").End(3).Row \ SplitLine) + 1
        If (SplitLine + startRow) > Cells(Rows.Count, "E").End(3).Row Then
            LastRow = Cells(Rows.Count, "E").End(3).Row     '// 마지막 행이 SplitLine 보다 작으면
        Else
            LastRow = SplitLine + startRow                  '// 마지막 행이 SplitLine 보다 크면
        End If
       
        Set rngDB = Range(Cells(startRow, "E"), Cells(LastRow, "E"))
        For i = startRow To LastRow     '// SplitLine 만큼 반복 수행하라
            If Cells(i, "G") = 0 Then
                Cells(i, "I") = Cells(i, "E") & " " & Cells(i, "F")
            Else
                Cells(i, "I") = Cells(i, "E") & " " & Cells(i, "F") & "-" & Cells(i, "G")
            End If
        Next i
       
        Set rngDB = Nothing
        startRow = i    '// 시작행으로 지정
    Next n
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

블로그 이미지

Link2Me

,
728x90

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

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

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



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

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


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



블로그 이미지

Link2Me

,
728x90

특정워크 시트를 별도의 파일로 저장하는 VBA 코드입니다.


Sub Sheet_SaveFile()
    Dim sht As Worksheet    '// 각 시트를 넣을 변수
    Dim FileName As String  '// 파일경로+날짜+이름 변수

    Application.ScreenUpdating = False  '// 화면 업데이트 정지
    Set sht = Worksheets("시트명")
    With ActiveSheet
            FileName = ThisWorkbook.Path & "\" & Date & " " & sht.Name & ".xlsx"
            sht.Copy    '// 시트 복사
            With ActiveWorkbook
                 .SaveAs FileName:=FileName '// 새로운 이름으로 저장
                 .Close '// 저장한 파일 닫음
            End With
    End With
    MsgBox "파일 저장완료"
End Sub

블로그 이미지

Link2Me

,
728x90

엑셀의 각 시트를 전부 파일로 저장하는 VBA 코드입니다.

만약 특정한 시트만 저장하고 싶다면

sht.Visible = True 대신에

sht.Name = "Sheet1" 으로 특정한 시트명을 적어주면 됩니다.


Option Explicit
Sub Sheet_To_SaveFile()   
    Dim sht As Worksheet    '// 각 시트를 넣을 변수
    Dim FileName As String   '// 파일경로+날짜+이름 변수

    Application.ScreenUpdating = False  '// 화면 업데이트 정지
    With ActiveWorkbook
        For Each sht In Worksheets
            FileName = .Path & "\" & Date & " " & sht.Name & ".xlsx"
            If sht.Visible = True Then  '// 숨기지 않은 시트이면
                sht.Copy                     '// 시트를 복사
                With ActiveWorkbook
                    .SaveAs FileName:=FileName '// 새로운 이름으로 저장
                    .Close '// 저장한 파일 닫음
                End With
            End If
        Next sht
    End With
    MsgBox "파일 저장완료"
End Sub


블로그 이미지

Link2Me

,
728x90

다른 시트에 일치하는 내용이 있는지 검사하여 포함되어 있는 행 출력


Option Explicit

Sub Sheets_FindText()
    Dim rngAll As Range   '// 현재 시트의 범위구간 설정
    Dim rngC As Variant   '// 현재 시트의 범위구간내의 변동되는 셀 변수
    Dim rngDB As Range    '// 검사할 시트의 범위구간 설정
    Dim rngT As Variant   '// 검사할 시트의 범위구간내의 변동되는 셀 변수
    Dim varTemp As Range      '// 임시변수 범위
    Dim i As Long         '// 카운트할 숫자
 
    Range("B2:C10").ClearContents
 
    Set rngDB = Worksheets("B").Range("B2", Worksheets("B").Cells(Rows.Count, "B").End(3))
    Set rngAll = Worksheets("A").Range("A2", Worksheets("A").Cells(Rows.Count, "A").End(3))
 
    For Each rngC In rngAll
        For Each rngT In rngDB
            Set varTemp = rngT.Find(What:=rngC, Lookat:=xlPart)   '// 부분일치(xlPart), 전수일치(xlWhole)
            If Not varTemp Is Nothing Then
                rngC.Offset(, 2) = rngC.Offset(, 2) & " , " & rngT.Offset(, -1)
                i = i + 1
            End If
        Next rngT
   
        rngC.Offset(0, 1) = i
        i = 0
        rngC.Offset(, 2) = Mid(rngC.Offset(, 2), 4, Len(rngC.Offset(, 2)))
        Debug.Print InStr(rngC.Offset(, 2), "1"), Len(rngC.Offset(, 2))
    Next rngC
 
    Set rngDB = Nothing      '// 변수 초기화
    Set rngAll = Nothing      '// 변수 초기화
End Sub


블로그 이미지

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

버그를 없애는 방법


1. 'Option Explicit'문을 사용
VB Editor 에서 '변수 선언 요구' 항목에 체크 표시를 해 두면 모듈 시트를 삽입할 때마다 맨 위에 'Option Explicit'이라는 문장이 자동 삽입됩니다.

모든 변수를 사용할 때 미리 선언(Dim)을 하고 사용해야 하므로 불편하다고 생각할 수 있지만 변수 이름과 관련된 입력 오류를 상당부분 줄일 수 있습니다.



자동 변수 선언하는 방법은

[도구] - [옵션] - [편집기] 에서 '변수 선언 요구'를 체크해주고 저장합니다.



모듈을 추가할 때마다 자동으로 아래와 같이 추가됩니다.




2. 주석(Comments)을 가급적 많이 사용
프로그래밍 세계에서는 '6개월만 지나면 자기 자신도 남'이라는 말이 있습니다.

코딩 시에는 조금 귀찮을 수 있지만 주석을 충실히 달아 놓으면 나중에 다시 살펴볼 일이 있을 때 큰 도움을 받을 수 있습니다.




3. 도움말과 전문가 사이트 활용
엑셀의 도움말은 문제가 발생하였을 때 가장 믿을만한 지원군 중 하나입니다.

뭔가를 하긴 해야겠는데 어떻게 해야할 지 생각나지 않는 경우,

전문가 사이트에서 검색어로 검색을 해서 원하는 참조하여 이용하고 주석처리를 잘 해두는 것도 방법입니다.

간단한 명령어가 생각나지 않는다면, 매크로 기록기를 통해 생성된 코드를 살펴보고 프로퍼티, 메서드를 도움말에서 찾아보는 것도 도움이 됩니다.



4. 들여쓰기(Indentation) 규칙을 적용
코딩 시 들여쓰기 규칙을 사용하면 가독성이 높아져서 전체적인 구조를 파악하기 쉬워집니다.

들여쓰기는 탭키를 이용하면 보기 좋게 정렬됩니다.



5. 엑셀의 디버깅 툴을 적극 사용
엑셀에는 여러 가지 종류의 디버깅 툴이 있습니다.

처음 사용할 때에는 귀찮고 복잡해 보일 수 있습니다만, 다소의 시간을 투자하여 이들 도구의 사용법을 잘 익혀 놓으면 실전에서 많은 도움이 됩니다.



직접 실행창 (Ctrl + G)를 누르면 하단에 직접 실행창이 보입니다.



이제 VBA Code 안에서 디버깅창(직접실행창)에 보일 내용을 Debug.Print 를 앞에 붙이고 실행을 합니다.


           
    FindText = InputBox("찾을 문자열 입력") '//찾을 문자열을 변수에 넣음
    If FindText = "" Then Exit Sub
   
    replace_Text = InputBox("[" & FindText & "] 을 바꿀 문자열을 입력하세요")
   
    Debug.Print "찾는문자열 : " & FindText
    Debug.Print "변경문자열 : " & replace_Text


이렇게 하면 디버깅창에 표시되지만 화면에서는 변경된 내역은 안보입니다.

Msgbox 를 이용하면 사용자가 일일이 '확인'이나 '취소'를 눌러줘야 하지만 Debug.Print 는 중단없이 다음 라인을 계속 실행합니다.

Debug.Print 변수이름  이렇게 하며 정상적으로 값을 뿌리는데

Debug.Print 배열  이렇게 하면 에러가 발생합니다. 이유를 알고 봤더니, ReDim Preserve 로 선언한 후에는 문제가 생기지 않았습니다.



직접 실행창에 뿌려지는 내용이 너무 많다면, Ctrl + A를 눌러서 전체 선택한 다음에 Delete 키로 지우면 전부 지워집니다.


코드를 한줄 한줄 실행하면서 제대로 로직이 맞게 된 것인지 확인하고 싶다면

F8키를 눌러서 한줄 한줄 실행을 합니다. 그러나, F8키만 누르는 경우에는 값이 어떻게 변경되는지 알기가 어렵습니다.

[보기] - [지역 창] 메뉴를 선택하면 '지역' 창이 표시됩니다. 이 상태에서 <F8> 키를 계속 눌러보면 각 변수에 값들이 어떻게 변하는지 알 수 있습니다.




위 그림을 보면 노란색 부분에 대한 식, 값, 형식이 하단 지역창에 보입니다.


전체가 아니라 중간점을 지정해두고 결과를 확인하고 싶다면



을 하고 F5키를 눌러서 실행하거나


를 눌러줍니다.

중단점 설정을 키보드로 하는 경우에는 F9 키를 누르면 됩니다.

중단점은 여러 곳에 설정할 수 있으며 설정을 해제하려면 중단점을 클릭하면 됩니다. 설정된 중단점들을 한꺼번에 모두 제거하려면 <Ctrl+Shift+F9> 키를 사용합니다.



코딩을 하다가 버그가 생겼을 때 빠르게 조치하기 위해서는 Debugging 하는 방법을 알아야 합니다.

그냥 단순한 방법으로 Msgbox 에 내용을 출력하도록 하여 결과를 볼 수도 있습니다만

디버깅 하는 방법을 배워두면 훨씬 편하고 좋습니다.


블로그 이미지

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

네이버 지식인에 올라온 자료를 정리해 본 것입니다.

연속된 15의 개수, 5의 개수, 0의 개수, 10의 개수가 반복횟수 기준으로 얼마나 되는지 구하는 경우입니다.





연속숫자구하기.xlsm



Sub 연속숫자개수구하기()
    Dim rngC, rngT  As Range
    Dim rngAll As Range
    Dim rngVariable As Range  '// 변하는 영역변수
    Dim i As Double  
   
    For Each rngC In Range([B2], Cells(Rows.Count, "B").End(3))
        If rngC <> rngC.Offset(1) Then
            i = 0
            rngC.Offset(, 1) = rngC.Offset(-1, 1) + 1
            rngC.Offset(, 2) = rngC
        Else
            i = i + 1
            rngC.Offset(, 1) = i
        End If
    Next rngC
   
    Set rngT = [D2].End(4)  '// D2 셀로부터 아래로 내려오면서 처음 값이 있는 셀
    For Each rngC In Range([D2], Cells(Rows.Count, "D").End(3))
        Set rngVariable = Range(rngT, rngC)
        If Not IsEmpty(rngC) Then
            rngC.Offset(0, 1) = Application.CountIf(rngVariable, rngC)
        End If
    Next rngC
   
    MsgBox "완료"
   
End Sub


Sub 값채우기()
    Dim rngC  As Range
    Dim i, n, lastCell As Double
   
    lastCell = Cells(Rows.Count, "J").End(3).Row
   
    For i = 1 To lastCell
        For n = 1 To 4
            For Each rngC In Range([E2], Cells(Rows.Count, "E").End(3))
                If Not IsEmpty(rngC) Then
                    If rngC = Cells(i + 3, "J") Then
                        If rngC.Offset(, -1) = Cells(3, n + 10) Then
                            Cells(i + 3, n + 10) = rngC.Offset(, -2)
                        End If
                    End If
                End If
            Next rngC
        Next n
    Next i
    MsgBox "완료"
   
End Sub










블로그 이미지

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

네이버지식인에 올라온 질문을 보고 작성을 했습니다.

한문과 발음기호가 분리되지 않은 걸 셀 분리를 하고 싶다는 내용입니다.

이 경우에는 한문이 먼저 나오고 발음기호는 뒤에 나오는 걸 분리하는 VBA Code 입니다.


Sub 한문과기호분리()
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
    Dim SplitPoint, i As Integer
    Dim TempStr As String

    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))    '// 범위 구간 지정
    '// A2 는 구간범위 시작셀, Cells(Rows.Count, "A").End(3)은 A열 값이 있는 마지막 셀

    For Each rngC In rngAll     '// rngC 는 각셀을 순환하는 셀, rngAll 은 전체 범위
        For i = 1 To Len(rngC)      '// rngC 셀의 각글자단위로 반복
            TempStr = Asc(Mid(rngC, i, 1))  '// 각 글자를 ASC값으로 변환하여 TempStr 변수에 저장
            If Not (TempStr >= -13663 And TempStr <= -514) Then    '// 한문이 아니면
                SplitPoint = i      '// 한문이 아닌 글자를 만나면 i 값을 기록하라
                Exit For            '// For문을 빠져 나가라
            End If
        Next i
        rngC.Offset(0, 1) = Trim(Mid(rngC, 1, SplitPoint - 1))  '// 현재 rngC 셀 기준으로 우측으로 1칸 이동
        rngC.Offset(0, 2) = Trim(Mid(rngC, SplitPoint, Len(rngC) - SplitPoint + 1))  '// 우측으로 2칸 이동
    Next rngC

    Set rngAll = Nothing  '// 변수 초기화
End Sub

블로그 이미지

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 코드에 아래 코드를 하나 추가하면 체크하는 날짜를 지난 경우에는 자동으로 파일이 삭제됩니다.

Date 는 오늘 날짜이고 , Dateserial 함수에 표기된 날짜는 유효기한 날짜입니다.

Auto_Open 함수명을 다른 이름으로 하면 자동 실행이 안됩니다.


Sub Auto_Open()
    If Date > Dateserial(2015, 3, 25) Then
        With ThisWorkbook
            If .Saved = False Then .Save
            .ChangeFileAccess Mode:=xlReadOnly           
            Kill .FullName
            .Close SaveChanges:=False
        End With
    End If
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

,