728x90

VBA 편집기 사용법


VBA 편집기로 VBA 코드를 입력하거나 다른 사람의 코드를 붙여넣기 해 볼때 알아두면 유용한 것을 적어봅니다.


엑셀에서 Alt + F11 키를 누르면 VBA 편집창이 열린다.

1번은 프로젝트 탐색기 창으로,
VBA코드를 안보이게 설정하면 Microsoft Excel 개체, 모듈, 폼 등이 어떻게 구성된 것인지 보이지 않는다.

엑셀의 시트명이 어떻게 보이는지 보면 Sheet1(Sheet1), Sheet2(VBA), Sheet3(DATA) 로 보이는 걸 알 수 있는데 사용자가 직접 입력한 Sheet Name 은 괄호안에 표기되는 걸 알 수 있다.

VBA 에서 엑셀 시트를 보이게 하거나 보이지 않게 할 수도 있고, 완전히 감출 수도 있는데 이때 프로젝트탐색기 창에 보이는 이름을 알면 편하다.



2. 속성창은 프로젝트탐색기 창에서 선택한 개체의 주요 속성을 표시한다.

3. 코드창은 코드를 직접 입력하거나, 다른 사람의 코드를 복사해서 붙여넣기를 하면서 VBA 코드를 짜는 창이다.

    VBA 코드창의 글씨가 10으로 되어 있어 보기가 좀 불편하다면 ....

     


         변수선언요구
       VBA 코드를 짤 때 변수를 제대로 선언하지 않고 짜도 실행되기도 하는데 오류가 발생하지 않도록 하려면

       변수를 선언하고 사용하도록 요구하는 이 옵션을 체크하고 사용하는 것이 좋다.

       

       

       엑셀을 종료했다가 다시 실행하면 모든 코드 창의 맨위에 Option Explicit 문이 나타난다.


4. 직접 실행창은
    VBA 코드의 결과를 확인하는 창으로 디버깅할 때 유용하다.
    


Sheet1 의 이름을 직접 실행창에서 직접 변경해 본 것이다. 보통은 엑셀시트에서 직접 이름을 변경하지만, 어떻게 변경되는지 확인해보고자 입력을 해봤다.


VBA 코드를 짜면서 결과를 확인해보고 싶을 때 직접 실행창에 ? 실행할 명령어 를 입력한다.

? Range("A2").Value 라고 입력하고 엔터키를 치면 A2 셀의 값을 직접 실행창에 결과로 보여준다.

? 는 Print 의 단축명령어다. 직접실행창에 입력한 글자를 전부 지우려면 Ctrl + A 를 눌러서 전체를 선택한 다음에 Delete 키를 눌러준다. 한줄만 삭제하려면 Ctrl +Y 를 누르면 커서가 있는 해당 Line만 삭제된다.










블로그 이미지

Link2Me

,
728x90

[VBA] 중복데이터 색깔 표시, 중복제거, 정렬


자료를 분류할 때 중복데이터가 들어 있는 걸 쉽게 찾아서 검토한 다음에 제거하고 싶은 경우가 있습니다.

이럴 때는 중복데이터가 들어간 셀을 배경색을 넣어서 표시한 다음에 찾으면 쉽게 구별할 수가 있습니다.



육안으로 찾는다는 것은 엄청난 시간 낭비죠.

VBA 코드를 사용하지 않고 찾는 방법은 필터를 설정하고, 글자순으로 소팅하는 방법이 되겠죠.

하지만 이 또한 일일이 육안 확인을 해야 하는 번거로움이 예상됩니다.

아래 VBA 코드를 이용하면 쉽게 찾아낼 수 있습니다.

Sub 중복색깔표시()
    Dim rngC As Range
    Dim rngAll As Range
    Dim i As Integer
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([C2], Cells(Rows.Count, "C").End(3))
    rngAll.Interior.Color = xlNone  '// 적용된 색깔 삭제
   
    For Each rngC In rngAll
        If Application.CountIf(rngAll, rngC) <> 1 Then  '// 중복데이터 있는 경우
            rngC.Interior.ColorIndex = 40   '// 배경색 지정, 색상표는 http://link2me.tistory.com/260 참조
            i = i + 1
        End If
    Next rngC   
    Set rngAll = Nothing

    If i > 0 Then
        MsgBox "중복개수 " & i & "개 발생"
    Else
        MsgBox "중복없음"
    End If
End Sub


그럼 이제 실행된 결과를 한번 보겠습니다.


   


먼저 소분류 항목에 필터를 걸고, 오름차순이나 내림차순 정렬을 합니다.

그 다음에 색 기준 정렬을 합니다.



이제 중복데이터가 뭔지 눈에 잘 들어오네요.


데이터가 엄청나게 많은 것을 중복 데이터를 육안으로 확인하고 나서 지우고 싶다면 이걸 실행하면 됩니다.

그럼 이제 중복데이터를 편하게 지우는 방법을 더 알아보겠습니다.

위 그림은 중복제거를 할 때 대분류, 소분류 기준을 모두 고려하여 중복데이터를 제거해야 원하는 결과를 얻을 수 있겠네요.


Sub 중복데이터제거()
    [A1].SpecialCells(5).RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes
   
    '// 2번째 열 기준으로 중복제거
    '[A1].SpecialCells(5).RemoveDuplicates Columns:=2, Header:=xlYes
   
    '// 3번째 열 기준으로 중복제거
    '[A1].SpecialCells(5).RemoveDuplicates Columns:=3, Header:=xlYes
End Sub


단 한줄로 중복데이터를 제거할 수 있습니다. array(2,3) 의 의미는 2번째열과 3번째열을 기준으로 하라.

Header:=xlYes 는 헤더가 있다. 헤더가 없을 경우에는 Header:=xlNO 로 한다.



이제 다시 색깔제거 VBA 코드를 사용하면 표시된 색깔이 없어질 것을 확인할 수 있습니다.



그럼 이제 정렬까지 하는 걸 알려줘야지....라고 하면

엑셀에서는



로 하면 됩니다.

그럼 VBA 코드로 한다면 ....

Sub 셀정렬()
    With Range("A1").CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, _
              key2:=.Cells(1, 3), order2:=1, _
              Header:=xlYes
    End With
End Sub


로 하면 됩니다.

order1:=1 에서 1은 오름차순, 2는 내림차순 을 의미하며, key는 최대 3개까지 지정할 수 있습니다.


duplicate_color.vbs


도움이 되셨다면 공감 꾸욱~~ 눌러주는 센스


블로그 이미지

Link2Me

,
728x90

행높이와 열너비 저장 및 복원


엑셀에서 복사를 하면 그대로 서식까지 복사가 되면서 행높이, 열너비까지 그대로 복사가 되는 경우라면 고민을 할 필요가 없습니다.

그런데 서식은 복사되는데 행높이, 열너비 정보는 가져오지 못하는 경우가 있어서 이걸 해결하기 위해서 고수분의 도움을 받았고 나머지는 제가 구현을 했습니다.

고수분이 알려주신 로직은 함수로 만들어서 깔금하게 처리했더군요. 전 그냥 기본 수준으로 처리했습니다.


엑셀의 행높이와 열너비를 구해서 파일로 저장하는 VBA 코드입니다.

첨부된 파일은 아래 코드입니다. 다운로드 받아서 텍스트 에디터로 열어서 복사하여 붙여넣기 하면 됩니다.

VBA 실행방법을 잘 모르시는 분은 http://link2me.tistory.com/565 참조해서 따라하면 금방 이해될 겁니다.


Row_Height_vba.vbs



Sub Save_RowHeight()

    Dim i%, Col As Variant, Ro As Variant

    

    ReDim Ro(1 To 30)

    For i = 1 To 30   '// 행의 개수는 필요한 경우 수정해줌

        Ro(i) = Cells(i, 1).RowHeight

    Next i

    Open ThisWorkbook.Path & "\ro.css" For Output As #1

    Print #1, Join(Ro, ",")

    Close #1  '// 작업을 마치고 파일을 닫는다

    

    ReDim Col(1 To Columns("Y").Column)

    For i = 1 To Columns("Y").Column

        Col(i) = Cells(1, i).ColumnWidth

    Next i

    Open ThisWorkbook.Path & "\col.css" For Output As #2

    Print #2, Join(Col, ",")

    Close #2   '// 작업을 마치고 파일을 닫는다

End Sub


저장된 파일에서 읽어서 행높이와 열너비를 자동으로 지정하는 VBA 코드입니다.

행높이와 열너비라서 저장된 파일이 한줄이라서 파일 여러줄을 읽을 필요가 없는 경우입니다.

그래서 줄의 마지막까지 데이터를 읽어서 처리하는 형태가 아님


Sub Get_RowHeight()

    Dim strTemp As String

    Dim varTemp As Variant

    Dim i, j As Integer

    

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

    Open ThisWorkbook.Path & "\ro.css" For Input As #1

    Line Input #1, strTemp

    varTemp = Split(strTemp, ",")

    For i = 0 To UBound(varTemp)

        Cells(i + 1, 1).RowHeight = Val(varTemp(i))

    Next i

    Close #1 '// 파일번호 닫기


    Open ThisWorkbook.Path & "\col.css" For Input As #2

    Line Input #2, strTemp

    varTemp = Split(strTemp, ",")

    For j = 0 To UBound(varTemp)

        Cells(1, j + 1).ColumnWidth = Val(varTemp(j))

    Next j

    Close #2 '// 파일번호 닫기

End Sub



블로그 이미지

Link2Me

,
728x90

엑셀내 모든 이미지 지우는 VBA



테이블 구조 설계를 하면서 코딩 작업을 하면서 테이블 구조를 수시로 참조하면서 작업을 해야 하는데 좀 불편해서 편하게 할 방법이 없나 고민하다가 phpMyAdmin 에서 테이블 구조를 Drag & Drop 으로 복사하여 엑셀에 붙여넣기를 했더니....


이런식으로 그림 이미지가 잔뜩 붙어있습니다.


이 이미지를 제거하는 VBA 코드 입니다.

Sub Delete_Shape()
    Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
        Shp.Delete
    Next Shp
End Sub


실행하고 나면 이미지가 모두 제거 됩니다.



간단하지만 필요에 따라 유용하게 사용할 수 있습니다.


블로그 이미지

Link2Me

,
728x90

인터넷에서 자료를 검색하다가 보면 자료가 콤마(,)로 부분되어 있고 이걸 가져와서 셀에 붙여넣기를 하면 한 셀에 데이터가 저장되는 경우가 있습니다.

자료를 분리한 다음에 특정 열기준으로 하단으로 자료를 죽 쌓고 싶은 경우에 사용하는 VBA Code 입니다.



셀분리정렬.xlsm


Sub Cell_Split_and_Column_Save()

    Dim rngC As Range

    Dim rnaAll As Range

    Dim varTemp As Variant

    Dim i, n As Integer

    

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

    rngCh = "A"                          '// 열지정

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

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

    

    For Each rngC In rngAll

        varTemp = Split(rngC, ",")

        For i = LBound(varTemp) To UBound(varTemp)  '// 배열 하한값에서 상한값까지 반복

                Cells(Rows.Count, "B").End(3)(2) = Trim(varTemp(i))  '// 분리한 문자를 셀에 입력

                n = n + 1

        Next i

    Next rngC


    Set rngAll = Nothing

    MsgBox "총 " & n & "개 완료"

End Sub




블로그 이미지

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


중복개수가 3이면 전부 3으로 표시하고 싶을 때 사용하는 VBA 코드 입니다.

중복개수를 구할 때는 가급적이면 중복개수 구할 필드를 Sorting(정렬) 해두면 빠릅니다.

엑셀에서 기본 제공하는 CountIF 함수를 VBA 에서 이용하고자 한다면 Applicaton.CountIF 처럼 앞에 Application 을 붙여주면 됩니다.

내가 잘 알고 있는 엑셀함수를 이용하고자 할 때에는 이렇게 사용하면 됩니다.

엑셀로 작업을 하다보면 중복개수를 전부다 표시를 해두면 유용한 경우가 있고, 중복을 카운트로 증가시키면 유용한 경우가 있습니다.

그런데 이 함수는 엑셀에서도 범위지정이 크면 메모리 에러가 발생하고, VBA 에서도 심한 지연현상이 발생하더군요. 제가 테스트한 범위는 30만개 데이터였습니다. 


Sub 중복개수표시()

    Dim rngC As Range

    Dim rngAll As Range


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

    rngCh = "A"                          '// 열지정

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

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


    For Each rngC In rngAll

        rngC.Offset(0, 1) = Application.CountIf(rngAll, rngC)

        '// 동일한 경우만큼 모두 숫자를 표시

    Next rngC


    Set rngAll = Nothing

    MsgBox "완료"

End Sub


먼저 Sorting 을 한다음에 데이터를 좀 잘게 잘라서 for 문으로 돌려가면서 처리하는게 방법이지 않을까 싶더군요. 그래서 중복개수 표시수를 증가하면서 표시되게 하는 VBA 코드를 만들어봤습니다.

SplitLine 은 500 정도될 때 속도가 가장 빠르던데 PC 환경마다 조금씩 다를 거라 봅니다.

고수분께서 잘못된 것이 있으면 지적해주시면 감사하겠구요.



Sub 중복개수표시()

    Dim rngDB As Range

    Dim i, n As Double

    Dim SplitLine, startRow, LastRow As Double  '// Integer 로 지정하면 버퍼오버플로우가 날 수 있다.

        

    startRow = InputBox("시작행을 입력하세요")

    If startRow = "" Then Exit Sub              '// 입력값이 없으면 매크로 중단

    If Not IsNumeric(startRow) Then Exit Sub     '// 숫자가 아니면 매크로 중단

    

    SplitLine = 3000

    

    For n = 1 To (Cells(Rows.Count, "D").End(3).Row \ SplitLine) + 1

    

        If (SplitLine + startRow) > Cells(Rows.Count, "D").End(3).Row Then

            LastRow = Cells(Rows.Count, "D").End(3).Row     '// 마지막 행이 SplitLine 보다 작으면

        Else

            LastRow = SplitLine + startRow                  '// 마지막 행이 SplitLine 보다 크면

        End If

    

        Set rngDB = Range(Cells(startRow, "D"), Cells(LastRow, "D"))

        For i = startRow To LastRow     '// SplitLine 만큼 반복 수행하라

            Cells(i, "E") = Application.CountIf(rngDB, Cells(i, "D"))

        Next i

        

        Cells(i - 1, "Q") = 1  '// for 문 종료 다음 셀을 찾기 쉽게 반복된 구간마다 1을 마킹하라

        Set rngDB = Nothing    '// 메모리 비우기 

       

        Do Until (Cells(i, "D") <> Cells(i - 1, "D"))   '// 조건이 충족될 때까지 처리를 반복하라

            i = i - 1

        Loop            '// 조건이 충족되면 Loop 다음으로 이동하라

        

        startRow = i    '// Do Until 문으로 셀이 서로 다른 행까지 찾은 값을 시작행으로 지정

        

       If Cells(Rows.Count, "D").End(3).Row <= LastRow Then Exit For    '// LastRow 보다 작으면 For 문을 종료

        'Application.Wait Now() + TimeValue("00:00:02")  '// 메모리 비우는 작업을 수행??

    Next n


    MsgBox "완료"

End Sub


약간씩 타이머로 대기를 하는 경우에도 약간 더 시간이 걸리기는 하지만 결과는 잘 나오더군요.


        Do Until (Cells(i, "D") <> Cells(i - 1, "D"))   '// 조건이 충족될 때까지 처리를 반복하라

            i = i - 1

        Loop            '// 조건이 충족되면 Loop 다음으로 이동하라


이 로직을 넣은 이유는 마지막 행이 중간에 걸쳐서 짤리는 경우 숫자 카운트가 제대로 안되는 문제를 정상적으로 처리하기 위해서 입니다.


블로그 이미지

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

,
728x90

주소에서 지역만 다시 정리


주소에 지역명이 제각각 나오는 경우가 있습니다.

이럴 경우 지역명을 2자리로 지정하는 VBA Code 입니다.


Sub 주소지역정리()
    Dim rngDB As Range
   
    With Sheets("addr_data")
        Set rngDB = .Range(.Cells(2, "E"), .Cells(Rows.Count, "E").End(3))  '// 주소가 들어있는 열 지정
        rngDB.Replace "경기도", "경기", xlPart
        rngDB.Replace "강원도", "강원", xlPart
        rngDB.Replace "경상북도", "경북", xlPart
        rngDB.Replace "경상남도", "경남", xlPart
        rngDB.Replace "충청북도", "충북", xlPart
        rngDB.Replace "충청남도", "충남", xlPart
        rngDB.Replace "전라북도", "전북", xlPart
        rngDB.Replace "전라남도", "전남", xlPart
        rngDB.Replace "제주도", "제주", xlPart
        rngDB.Replace "인천광역시", "인천", xlPart
        rngDB.Replace "대전광역시", "대전", xlPart
        rngDB.Replace "부산광역시", "부산", xlPart
        rngDB.Replace "대구광역시", "대구", xlPart
        rngDB.Replace "인천광역시", "인천", xlPart
        rngDB.Replace "울산광역시", "울산", xlPart
        rngDB.Replace "서울특별시", "서울", xlPart
        rngDB.Replace "세종특별자치시", "세종", xlPart
    End With
    MsgBox "주소지역 정리완료"
End Sub

블로그 이미지

Link2Me

,
728x90

주소 지역명 자동추출 VBA


엑셀을 다루다보면 주소를 정리해야 할 때가 있습니다.

주소에 나온 지역명을 2자리만 자동으로 추출하고 싶은 경우 아래 VBA 코드를 사용하면 금방 추출이 가능합니다.

시작하는 열과 시작행을 써주기만 하면 알아서 자동으로 우축에 지역명을 추출해 줍니다.


지역명추출.vbs


Sub 지역명추출()
    Dim rngC As Range       '// 각 Line 변수
    Dim rngAll As Range     '// 전체 범위 지정
    Dim rngCh
    Dim StartRow As Integer

    Application.ScreenUpdating = False   '// 화면 업데이트 (일시) 중지
    rngCh = "D"                          '// 열지정
    StartRow = 3                      '// 데이터 시작행 설정
    Set rngAll = Range(Cells(StartRow, rngCh), Cells(Rows.Count, rngCh).End(3))  '// 범위지정

    If Cells(StartRow - 1, rngCh).Offset(0, 1) <> "지역" Then
        Cells(StartRow - 1, rngCh).Offset(0, 1).EntireColumn.Insert
        Cells(StartRow - 1, rngCh).Offset(0, 1) = "지역"
        Cells(StartRow - 1, rngCh).Offset(0, 1).ColumnWidth = 6    '// 열너비 설정
    End If

    For Each rngC In rngAll
        Select Case Left(rngC, 2)
            Case "충청"
                If Left(rngC, 4) = "충청북도" Then
                    rngC.Offset(0, 1) = "충북"
                Else
                    rngC.Offset(0, 1) = "충남"
                End If
            Case "전라"
                If Left(rngC, 4) = "전라북도" Then
                    rngC.Offset(0, 1) = "전북"
                Else
                    rngC.Offset(0, 1) = "전남"
                End If
            Case "경상"
                If Left(rngC, 4) = "경상북도" Then
                    rngC.Offset(0, 1) = "경북"
                Else
                    rngC.Offset(0, 1) = "경남"
                End If
            Case Else
                rngC.Offset(0, 1) = Left(rngC, 2)
        End Select
    Next rngC
   
    rngAll.Offset(0, 1).HorizontalAlignment = xlCenter     '// 지역명 열 가운데 정렬
   
    Set rngAll = Nothing  '// 변수 초기화 (메모리 할당 해제)
    MsgBox "완료"
End Sub


블로그 이미지

Link2Me

,
728x90

SRT 자막파일을 엑셀 VBA 로 편집


SRT 자막파일의 구조를 보면 이렇게 생겼다.

번호와 바로 아래 타임코드(timecode) 정보가 있다.

그리고 그 아래에 자막내용이 있다.

동영상 플레이어에서는 이 타임코드 정보를 기준으로 해서 자막을 화면에 뿌려주게 된다.

자막파일을 가지고 이런 타임코드 정보는 전부다 지우고 자막내용만 남기고 싶은 경우의 VBA 코드를 만들어봤다. 아래코드처럼 한 이유는 자막 내용에 숫자만 들어간 경우가 있을 수 있다.

자막 내용은 지우지 않고 순수하게 타임코드 위의 번호(숫자)만 지우는 걸 고려해서 코드를 만들어봤다.



Sub Sub_Editing()
    Dim rngAll As Range
    Dim i As Integer

    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    Set rngAll = Range([A1], Cells(Rows.Count, "A").End(3))

    For i = rngAll.Cells.Count To 1 Step -1     '// 맨 마지막 줄부터 시작해서 거꾸로 i 값을 줄여나가라
        If InStr(Cells(i, 1), ":") And InStr(Cells(i, 1), "-->") Then   '// 타임코드 정보가 포함되어 있다면
            If IsNumeric(Cells(i - 1, 1)) Then                                   '// 타임코드 정보 윗줄이 숫자라면
                Range(Cells(i, 1), Cells(i - 1, 1)).EntireRow.Delete    '// 두줄을 지워라
            End If
            i = i - 1                                                      '// 두줄을 지웠으니 i 값을 하나더 빼라
        ElseIf Trim(Cells(i, 1)) = "" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next i
   
    Cells(1, 1).Select
    MsgBox "자막정리완료"
End Sub


블로그 이미지

Link2Me

,
728x90

데이터량이 많을 때 중복체크 빠르게 하는 팁


엑셀 데이터량이 많을 때 중복체크를 하기 위해서 함수를 만들어서 사용하는 것이 좋을까요?

VBA 를 배우면서 중복체크 하는 걸 이용해보는데 속도문제가 장난아니게 느린 경우도 많이 발생하더군요.

아무래도 사용자가 만들어서 사용하는 알고리즘은 엑셀 자체에서 제공하는 알고리즘보다 최적화가 안되어 훨씬 느릴 수 있다는 점입니다.


데이터량이 많을 때 제가 사용하는 방법은

0. 가장 먼저 No를 줄 열을 생성해서 순차 번호를 기록한다. (자료가 틀어지는 것을 방지하기 위한 목적)

1. 먼저 제목열일 기준으로 필터를 걸어서 정렬하고 싶은 열을 내림차순/오름차순으로 정리를 한다.

2. 정렬하고 싶은 열(중복체크 대상)을 바로 위아래 열간에 중복체크를 하기 위해서

   바로 옆에 하나의 열을 추가한다.

3. 엑셀은 기본적으로 대문자, 소문자를 검사하지 않는데

   대문자, 소문자를 검사하는 EXACT 함수를 이용해서 위아래 열을 검사한다.

   즉, IF(EXACT(C2,C3),1,0) 이런 식으로 조건을 걸어서 검사한다.

4. 그래서 불일치된 열을 기준으로 소팅을 한다.

5. 불필요한 행만 선택해서 삭제를 한다.


이런 방법으로 하는게 때로는 중복체크하는 함수를 사용할 때보다 훨씬 더 빠른 결과를 얻을 수 있습니다.


조금이나마 도움이 되셨다면 공감 꾸~욱 눌러주세요.


블로그 이미지

Link2Me

,
728x90

고급 Split 함수 사용법


Split(text_here, separator) 함수는 seperator 를 기준으로 텍스트 열을 나눕니다.

  * text_here : 자르고자 하는 문자열

  * split는 데이터(텍스트열)를 기준문자(seperator)로 나눠서 배열에 저장하는 것

  * 어떠한 특정 문자를 기준으로 값을 자르고 싶을 때 사용됩니다


고급 Split 함수라고 표현하는게 맞는지 모르겠지만 무심코 지나치기 쉬운 걸 배우게 되어 적어봅니다.

가장 간단하게 나누는 것을 알아봅시다.



varTemp = Split("David Lloyd George", " ") 라고 하면


처럼 공백을 기준으로 나눠서 배열로 가지고 있습니다.

varTemp(0), varTemp(2), varTemp(2)

이걸 원하는 셀에다가 뿌려주도록 하면 됩니다.


위와 같이 구분자(seperator)가 간단한 경우에는 비교적 쉬운 편입니다.


나누고자 하는 텍스트의 변수는 TXT 라고 하고 내용은 "안녕하세요홍길동의Split강좌에 오신것을환영합니다"

라고 해봅시다.


varTemp = Split(TXT, " ")

varTemp(0) = "안녕하세요홍길동의Split강좌에"

varTemp(1) = "오신것을환영합니다"

가 되겠지요..


그런데 이걸 다르게 표시하는 방법이 있습니다.

Split(TXT, " ")(0) = "안녕하세요홍길동의Split강좌에"

Split(TXT, " ")(1) = "오신것을환영합니다"


이와 같이 표현할 수 있는데 이건은 Split 함수를 이중으로 사용할 때 유용합니다.

찾고자 하는 구분자가 글자 한글자가 아니고 일정한 문자열을 사용해도 된다는 것을 초보자는 잘 모릅니다. 저도 단순한게 글자 한글자 또는 간단한 구분자만 생각했었거든요.

Split(Split(TXT, " ")(0), "Split")(0)

Split(Split(TXT, " ")(0), "Split")(1)

라고 할 수 있는데 이 경우 값이 어떻게 들어가는지 보면


Split(Split(TXT, " ")(0), "Split")(0) = "안녕하세요홍길동의"

Split(Split(TXT, " ")(0), "Split")(1) = "강좌에"

가 됩니다.


이처럼 Split을 중첩으로 잘라서 원하는 결과값을 찾아낼 수가 있습니다.


예제를 하나 살펴봅시다.


여기서 구하고자 하는 값은 307 이라고 합시다.

Split 함수를 이용해서 원하는 결과를 찾아낼 수가 있습니다.

위 그림의 텍스트를 TXT 라는 변수를 사용한다고 하면 ....

Split(Split(TXT, "class=""article"">")(1), "개")(0)

라고 하면 됩니다.


잘 이해가 안되나요?

Split(TXT, "class=""article"">")(1) 이라고 하면 seperator 인 class="article"> 를 기준으로 뒤의 값을 의미합니다. 따옴표 앞에는 "를 한번 더 붙여줘야 제대로 인식합니다.

seperator 를 기준으로 문자열이 엄청 길다고 해도 뒷부분을 의미한다는 것을 기억하면 되구요.

이제 다시 Split(Split(TXT, "class=""article"">")(1), "개")(0) 를 하면

class="article"> 의 뒷부분의 문자열 중에서 구분자(seperator) 를 기준으로 나눠서 앞에 있는 값을 의미합니다.

그러므로 class="article">307개 사이에 있는 307을 구할 수 있게 됩니다.




블로그 이미지

Link2Me

,
728x90

엑셀과 MySQL 연동처리


엑셀과 MySQL 연동처리를 하기 위한 기초 설명은 http://link2me.tistory.com/421 참조하면 됩니다.

기본적인 환경설정을 위한 정보는 다 설정되었다고 가정하고 추가적인 걸 설명하겠습니다.

MySQL DB 설정에서 DB.Table 을 % 권한을 부여하면 외부 엑셀에서 접속이 가능합니다.

변수선언, DB연결, DB open 하고 테이블의 Column 가져다가 엑셀에서 작업, DB close 하는 순서로 코드가 작성됩니다. 아래 코드는 개념적인 이해를 돕는데 사용하려고 인터넷 자료를 이것 저것 참조하고 짜집기를 좀 한 것입니다. SQL 을 다루는 것이므로 SQL 에 대한 공부가 좀 선행되어야 합니다.

엑셀 Cell 에 있는 값을 조건으로 SQL 문의 WHERE 조건을 걸 때 변수를 어떻게 입력하는지 아셔야 연동하여 원하는 작업을 할 수 있습니다.

저는 MySQL 과 연동하여 MySQL 이라고 했지만 다른 DB와도 연동이 되며, 엑세스와도 연동이 가능합니다.


Sub getMySQLData()

    Dim DBconn As ADODB.Connection

    Dim dbRecset As ADODB.Recordset

    Dim sSQL As String

    Dim iRow As Long, n As Long


    Set DBconn = New ADODB.Connection

    DBconn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver};" & _

                            "SERVER=localhost;" & _

                            "PORT=3306" & _

                            "DATABASE=test;" & _

                            "UID=testname;PASSWORD=testpasswd;OPTION=3"   

 

    DBconn.Open  '// 실제 DB 접속

'// 테이블에서 가져온 데이터의 조건을 걸어서 검사하고 싶다면 For Each 문을 여기에 설정

    '// 테이블에서 가져올 Column 을 SELECT 한다. 

    sSQL = "SELECT * FROM tblName Where 조건"     

 

    '// Create a recordset and set the CursorLocation property for record navigation

    Set dbRecset = New ADODB.Recordset

    dbRecset.CursorLocation = adUseClient

 

    '// MySQL DB 데이터 가져오기

    dbRecset.Open Source:=sSQL, ActiveConnection:=conn, CursorType:=adOpenForwardOnly, _

                  LockType:=adLockReadOnly, Options:=adCmdText


   dbRecset.MoveFirst   '// MySQL 가져온 데이터의 첫번째 열로 이동하라

 

    '//  첫번째 열의 값을 Cells 에 저장하라 

    For n = 1 To dbRecset.Fields.Count 

        Worksheets(1).Cells(1, n).Value = dbRecset.Fields(n - 1).Name 

    Next n

 

    '// MySQL에서 가져온 데이터를 엑셀 시트에 저장 

    For iRow = 1 To dbRecset.RecordCount   '// Record(행) 수

        For n = 1 To dbRecset.Fields.Count   '// Fields(열) 수

            Worksheets(1).Cells(iRow + 1, n) = dbRecset.Fields(n - 1)

         Next n

         dbRecset.MoveNext

     Next iRow

'// For Each 문의 Next rngC

'//  접속 종료

    dbRecset.Close

    DBconn.Close


    Set dbRecset = Nothing

    Set DBconn = Nothing 

End Sub


Where 조건을 줄 때 어떻게 하는지 한번 살펴보자.

엑셀 셀의 변수를 어떻게 주었는지 주의해서 보셔야 합니다.


strSQL = "select 전화번호 from DB테이블명 "
strSQL = strSQL & "WHERE RIGHT(전화번호,4)='" & myTel & "' "
strSQL = strSQL & "ORDER BY RIGHT(전화번호,4) "


strSQL = "SELECT 품명, SUM(수량) AS 수량합  "
strSQL = strSQL & "FROM
DB테이블명 "
strSQL = strSQL & "WHERE 입고일>='" & dStart & "' AND  입고일<='" & dEnd & "'  "
strSQL = strSQL & "GROUP BY  품명 "

sSQL = "INSERT INTO `info` VALUES (" & i & ",'" & Text1.Text & "','" & Text2.Text & "');"

블로그 이미지

Link2Me

,
728x90

홀수행 또는 짝수행만 추출하는 VBA


홀수행 또는 짝수행만 추출해서 데이터를 추출하고 싶을 때가 있습니다.

이럴 때는 추출하고자 하는 열이 A열이라고 할 때, B열에 번호 순번을 주고 B열을 기준으로 홀짝을 판별하여 A열의 값을 C열에 추출하는 것입니다.

Cells(Rows.Count, "C").End(3)(2) 의 의미는 데이터가 있는 값의 아래에다가 계속 쌓아라 라는 의미입니다.

그러므로 C열에 마지막 셀을 인식할 수 있도록 값을 하나 넣어주면 그 다음셀부터 값을 저장할 것입니다.


Sub 홀수행추출()
    Dim rngC As Range
    Dim rngAll As Range
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([b2], Cells(Rows.Count, "b").End(3))
   
    For Each rngC In rngAll
        If rngC Mod 2 = 1 Then
            rngC.Offset(, -1).Copy Cells(Rows.Count, "C").End(3)(2)
        End If
    Next rngC
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "작업완료"
End Sub

블로그 이미지

Link2Me

,
728x90

[VBA기초] 틀리기 쉬운 사소한 실수


엑셀 Exact 함수로 두 셀간의 정확성 검사를 했다.

결과가 TRUE, FALSE 라고 대문자로 셀에 표시된다. 전부 값으로 변경하고 나서 CTRL + H 로 전부 1 또는 0 으로 변경하는 작업을 했더니 처리시간이 좀 걸린다.

그래서 아래 VBA 코드를 만들어서 검사식을 If rngC.Value = "TRUE" 라고 했더니 변화되는 것이 전혀 없다.

분명히 셀에 표시되는 것에는 값으로 TRUE 라고 나와 있으니까, 당연히 제대로 맞을 거라고 봤는데 ㅠㅠㅠㅠ

그래서 Msgbox rngC.Value 로 값을 확인해 봤더니 돌려주는 갑이 True 라고 돌려준다.

이런 제길~~~ 화면에 보여주는 건 대문자로 보여줘서 대문자가 맞나 했더니 다르게 돌려준다.

혹시 이런 사소한 실수를 하고 있는 건 아닌지 검증하는 작업은 Msgbox 를 이용하여 화면에 띄워보거나

Debug.Print 변수

한줄을 넣고 검사해보는 겁니다.


Sub TRUE검사()

    Dim rngC As Range

    Dim rngAll As Range

    Dim i As Integer

    

    ActiveCell.Select    '// 현재 커서가 위치한 셀

    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))

    For Each rngC In rngAll

        If rngC.Value = "True" Then

            rngC.Value = 1

            i = i + 1

        End If

    Next rngC

    

    Set rngAll = Nothing

    MsgBox "총 " & i & "개 변환"

End Sub

블로그 이미지

Link2Me

,
728x90

셀을 분리하고 검사를 한 다음에 값을 저장하는 VBA


셀을 분리하여 검사하고 나서 치환한 다음 다시 합치는 결과를 도출해야 할 일이 있어서 만들어 본 VBA 입니다.

VLOOKUP 을 사용하면 결과를 빠르게 돌려주기 때문에 VBA 함수를 호출해서 결과를 얻었습니다.


Sub 셀분리검사저장()

    Dim rngC As Range

    Dim rngAll As Range

    Dim i As Integer

    Dim varTemp

    Dim deLimiter, sTxt As String

    Dim table_array As Range

    Dim table_array2 As Range


    Set rngAll = Range([E3], Cells(Rows.Count, "E").End(3))

    deLimiter = " "     '// 구분자

    Set table_array = Sheets("DB").Range("A2:B23542")   '// VLookup 테이블

    Set table_array2 = Sheets("DB").Range("B2:B23542")   '// VLookup 테이블


    For Each rngC In rngAll

        varTemp = Split(rngC, deLimiter)  '// 구분자로 셀을 분리하여 varTemp 배열에 저장

        For i = LBound(varTemp) To UBound(varTemp) - 1   '// 배열의 가장 작은 숫자와 가장 큰 숫자를 추출

            '// i = 0 부터 시작

            sTxt = sTxt & varTemp(i) & deLimiter   '// For 문에서 지정된 것만큼 셀을 합쳐서 하나의 sTxt  로 만듬

        Next i

        sTxt = Trim(sTxt)

        If Len(sTxt) Then

            If Not IsError(Application.VLookup(sTxt, table_array2, 1, 0)) Then   '// 정상적이면

                sTxt = sTxt

            Else

                If IsError(Application.VLookup(sTxt, table_array, 2, 0)) Then

                    sTxt = "[Err] " & sTxt

                Else

                    sTxt = Application.VLookup(sTxt, table_array, 2, 0)  '//서로 일치하는게 있으면 table_array 의 두번째 열의 값을 sTxt에 저장하라

                End If

            End If

            rngC = sTxt & " " & varTemp(UBound(varTemp))

        End If

        sTxt = vbNullString     '// 값을 초기화

    Next rngC

    

    Set rngAll = Nothing

    Set table_array = Nothing

    Set table_array2 = Nothing

    

    MsgBox "검사완료"


End Sub



블로그 이미지

Link2Me

,
728x90

우편번호 주소 정리


전국 우편번호 자료를 구할 수 있는 곳은 우정사업본부 사이트에 가면 있습니다.

우정사업본부 URL : http://www.koreapost.go.kr/kpost/sub/subpage.jsp?contId=010101040300

엑셀로 된 자료를 받아서 원하는 자료를 만들기 위해서 작업을 해봤습니다.


시도 / 시군구 / 읍면동 / 리

로 나눠진 걸 가지고 F열처럼 작업을 했습니다.

rngC.Offset(0, i)의 의미만 알면 아래 VBA Code 이해는 쉽게 됩니다.

rngC.Offset(0, i) 에서 Offset(행,열) 이라고 이해하면 됩니다.

rngC 순환 반복하는 셀에서 rngC.Offset(0,0)은 A열의 셀, rngC.Offset(0,1)은 오른쪽으로 한열 이동한 셀이므로 B열, rngC.Offset(0,2)는 C열, rngC.Offset(0,3)은 D열 입니다.

처음 sTxt 에는 값이 없고, For 문을 순환하면서 값이 변수에 저장됩니다.


Sub 주소정리()
    Dim rngC As Range
    Dim rngAll As Range
    Dim sTxt As String
    Dim deLimiter As String
    Dim i As Integer
           
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지

    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))   
    deLimiter = " "     '// 구분자
    For Each rngC In rngAll      '// 각 행을 순차적으로 반복 수행
        For i = 0 To 3  '// A열부터 D열까지 반복
            sTxt = sTxt & rngC.Offset(0, i) & deLimiter
        Next i
        rngC.Offset(0, 5) = Trim(sTxt)  '// 한행 작업의 결과를 셀에 저장
        sTxt = vbNullString     '// 한 행의 작업이 끝났으므로 값을 초기화
    Next rngC
    Set rngAll = Nothing     '// 변수 초기화   
End Sub



이번에는 변환주소를 가지고 아래 형태로 자료를 추출하려면 어떻게 해야 할까요?


Split 함수를 이용하여 B열의 셀을 배열로 분리하고, 배열 값을 가지고 아래 코드처럼 변환해줍니다.

varTemp 라는 배열은 varTemp(0), varTemp(1), varTemp(2) 이런 식의 값으로 분리됩니다.

배열의 크기가 달라질 수 있으므로 UBound(varTemp) 를 사용하여 가변 변수 최대숫자를 구합니다.

변수에 맞게 Left 함수를 이용하여 sTxt 값을 만들어내고, 원하는 셀에 저장합니다.


Sub 주소변경()
    Dim rngC As Range
    Dim rngAll As Range
    Dim sTxt As String
    Dim deLimiter As String
    Dim varTemp
    Dim i As Integer
           
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지
    Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))
    deLimiter = " "      '// 구분자   
    For Each rngC In rngAll     '// 각 행을 순차적으로 반복 수행

        varTemp = Split(rngC, deLimiter)    '// 구분자로 셀을 분리하여 배열에 저장
        For i = 1 To UBound(varTemp)
            sTxt = sTxt & Left(varTemp(i), Len(varTemp(i)) - 1) & deLimiter
        Next i
        rngC.Offset(0, -1) = varTemp(0) & deLimiter & Trim(sTxt)
        sTxt = vbNullString    '// 한 행의 작업이 끝났으므로 값을 초기화
    Next rngC
    Set rngAll = Nothing    '// 변수 초기화
End Sub



블로그 이미지

Link2Me

,
728x90

찾고자 하는 단어 전부 찾는 VBA


엑셀을 다루다보면 셀에 포함된 단어를 찾아야 할 경우가 있습니다.


FindVBA.vbs


Sub Character_Find()

    Dim rngC As Range

    Dim rngAll As Range '//대상 범위 지정변수

    Dim FindText As String

    Dim strAddr As String

    Dim S As Integer

    

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

    'Set rngAll = ActiveSheet.UsedRange

    Set rngAll = Range([C3], Cells(Rows.Count, "C").End(3))

    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음

       

    FindText = InputBox("검색할 문자 입력") '//검색할 문자를 변수에 넣음

    If FindText = "" Then Exit Sub           '// 취소 선택시 매크로 중단

    Range([F3], Cells(Rows.Count, "F").End(3)).ClearContents  '// 찾는 값을 기록한 열을 초기화

            

    With rngAll

        .Font.Bold = False

        .Font.ColorIndex = xlAutomatic

        Set rngC = .Find(what:=FindText, lookat:=xlPart)

                

        If Not rngC Is Nothing Then

            strAddr = rngC.Address '// 찾은 셀의 주소를 변수에 넣음

            Do

                S = 1

                Do

                    With rngC.Characters(Start:=InStr(S, rngC, FindText), Length:=Len(FindText)).Font

                    '.Bold = True   '// 굵은 글씨로 표시하고 싶으면

                    .Color = vbBlue '// 글자색 표시, vbGreen 녹색 vbRed 빨간색

                    End With

                    

                    rngC.Offset(0, 3) = FindText

                    S = InStr(S, rngC, FindText) + Len(FindText)

                Loop While InStr(S, rngC, FindText)

                Set rngC = .FindNext(rngC) '// 다음 찾은 데이터를 변수에

            Loop While Not rngC Is Nothing And strAddr <> rngC.Address

            '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복

        End If

    End With

    

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

End Sub

블로그 이미지

Link2Me

,
728x90

셀 분리 활용


데이터가 하나의 셀로 되어 있어서 두개로 분리를 해야 할 경우가 있습니다.

아래 VBA 코드를 가지고 msgbox Ubound(varTemp) 도 넣어서 F8 키를 눌러서 확인 등을 해보면 확실하게 알 수 있습니다.

하나하나 분리해야 할 때에는 For i Next 구문 대신에 rngC.Next.Resize(1,Ubound(varTemp)) = varTemp 를 넣어주면 됩니다. 


Sub 셀분리()

    Dim rngC As Range

    Dim rngAll As Range

    Dim i As Integer

    Dim varTemp

    Dim deLimiter, sTxt As String

            

    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))

    deLimiter = " "     '// 구분자

    

    For Each rngC In rngAll

        varTemp = Split(rngC, deLimiter)  '// 구분자로 셀을 분리하여 varTemp 배열에 저장

        For i = LBound(varTemp) To UBound(varTemp) - 1   '// 배열의 가장 작은 숫자와 가장 큰 숫자를 추출

            '// i = 0 부터 시작

            sTxt = sTxt & varTemp(i) & deLimiter   '// For 문에서 지정된 것만큼 셀을 합쳐서 하나의 sTxt  로 만듬

        Next i

        rngC.Next = sTxt    '// 현재 셀 오른쪽에 sTxt 를 저장

        rngC.Offset(0, 2) = varTemp(UBound(varTemp))   '// 마지막 부분을 현재셀 오른쪽 2번째 셀에 기록

        sTxt = vbNullString     '// 값을 초기화

    Next rngC

    

End Sub



블로그 이미지

Link2Me

,