빈셀은 지우고 한글은 우측셀로 이동시키는 VBA

Sub 빈셀지우고한글우측이동()
    Dim Counter
    Dim splitT As Byte '// (시작위치 변수 지정
    Dim endT            '// ( 마지막 위치 지정
    Dim i As Integer
    Dim rngTarget As Range
 
    Application.ScreenUpdating = False      '//화면 업데이트 (일시)정지
    ActiveCell.Select
    Set rngTarget = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
    Counter = rngTarget.Rows.Count
    ' 반복할 줄 수 표시
    For i = 1 To Counter
        ActiveCell.Hyperlinks.Delete         '// 하이퍼링크 제거
        ActiveCell.Value = Trim(ActiveCell.Value)  '해당셀의 좌우 공백을 제거     
        If ActiveCell.Value = "" Then
            Selection.EntireRow.Delete     '//공백이면 해당 행을 삭제하라
            Counter = Counter - 1    '//전체 행수를 하나 줄여라
        ElseIf InStr(ActiveCell.Value, "(") = 1 Then  '//첫글자에 (가 들어가 있으면
            splitT = InStr(ActiveCell.Value, "(")
            endT = InStr(ActiveCell.Value, ")")
            ActiveCell.Value = Mid(ActiveCell.Value, splitT + 1, endT - splitT - 1)          
            ActiveCell.Offset(1, 0).Select  '// 다음 셀로 이동
        ElseIf InStr(ActiveCell.Value, "(") > 0 Then
            splitT = InStr(ActiveCell.Value, "(")
            endT = InStr(ActiveCell.Value, ")")
            ActiveCell.Offset(0, 2) = Mid(ActiveCell.Value, splitT + 1, endT - splitT - 1)
            ActiveCell.Value = Left(ActiveCell.Value, splitT - 1)          
            ActiveCell.Offset(1, 0).Select  '// 다음 셀로 이동
        ElseIf InStr(ActiveCell.Value, ";") > 0 Then
            splitT = InStr(ActiveCell.Value, ";")
            ActiveCell.Offset(0, 2) = Trim(Mid(ActiveCell.Value, splitT + 1, Len(ActiveCell.Value) - splitT + 1))
            ActiveCell.Value = Trim(Left(ActiveCell.Value, splitT - 1))           
            ActiveCell.Offset(1, 0).Select   '// 다음 셀로 이동
        ElseIf Left(ActiveCell.Value, 4) Like "*[가-힣]*" Then   '// 해당 셀이 한글을 포함하는지 검사
            Selection.Cut  '//해당셀 잘라내기
            ActiveCell.Offset(-1, 1).Range("A1").Select  '// 위로 한줄 이동하고 오른쪽으로 한칸 이동
            ActiveSheet.Paste  '// 값 붙여넣기
            ActiveCell.Offset(1, -1).Range("A1").Select  '// 아래로 한줄 이동하고 왼쪽으로 한칸 이동
            Selection.EntireRow.Delete  '// 한줄 전체 삭제
        Else           
            ActiveCell.Offset(1, 0).Select  '// 다음 셀로 이동
        End If
    Next i

    'Columns("A:H").AutoFit
    '열의 너비를 자동으로 맞추는 건데 필요하면 콤마 제거하고 사용하세요

End Sub

INSTR 함수를 이용하여 [ ] 사항도 처리할 수도 있고 원하는 사항을 IF문으로 추가하면 됩니다.

간혹 자료가 하이퍼링크가 걸려 있는 경우도 있을때도 있어 추가를 해두었는데 필요한 사항에 따라 추가하거나 삭제해서 사용하면 됩니다.

위 VBA 코드는 현재 셀(ActiveCell) 아래셀로 내려가면서 해당사항을 처리합니다.

따라서 IF문의 순서에 따라 우선순위가 정해집니다.

VBA 괄호제거

Sub 괄호제거()
    '문자열 중 ()괄호 안의 문자열만 따로 추출하기
    Dim rngTarget As Range '해당 영역을 변수로 지정
    Dim C As Range '셀을 지정
    Dim startChk As Byte '(시작위치 변수 지정
    Dim endChk As Byte ')끝위치 변수 지정
    Dim tmpString As String '추출 문자열 임시 저장 변수
  
    Set rngTarget = Selection  '// 선택한 영역만 할 경우
    Application.ScreenUpdating = False      '화면 업데이트 (일시)정지

    'ActiveCell.Select    '// Selection 으로 선택할 경우에는 이 Line 도 주석처리해야 함
    'Set rngTarget = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
  
    For Each C In rngTarget
        C.Value = Trim(C.Value)
        startChk = InStr(C.Value, "(")
        endChk = InStr(C.Value, ")")
      
        '// ()가 포함된 문자열 추출
        'tmpString = Mid(C.Value, startChk, endChk - startChk + 1)
        'C.Offset(0, 1).Value = tmpString
      
        '// ()를 제외한 문자열 추출
        'tmpString = Mid(C.Value, startChk + 1, endChk - startChk - 1)
        'C.Offset(0, 2).Value = tmpString

        '// 자체 Cell 에 덮어쓰기
        If startChk = 1 Then
            C.Value = Mid(C.Value, startChk + 1, endChk - startChk - 1)
        End If
      
    Next C   
    Set rngTarget = Nothing
End Sub

빈행제거

엑셀에서 중간 중간 빈행이 많아서 이걸 지우고 싶을 때 사용하는 VBA 코드다.

선택된 열 기준으로 빈셀을 만나면 그 행 전체를 지우므로 빈셀 옆에 데이터가 있어도 지워진다.

VBA는 간단한 프로그램이므로 내가 생각하는 것으로 해결이 어려우면 역발상으로 반대로 되는 걸 고려하여 실행하면 쉽게 풀리기도 한다.

통상적으로 빈행 삭제는 뒤에서부터 앞으로 실행해야 한다.

Sub 빈행삭제()
    Dim i As Double
    Dim LastRow As Double
    Dim r As Double
      
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시) 정지
    LastRow = Cells(Rows.Count, "B").End(3).Row  '// 조건을 설정할 행 지정

    For i = LastRow To 1 Step -1
        If Cells(i, "C").Value = "" Then
            Cells(i, "C").EntireRow.Delete
            r = r + 1
        End If
    Next i
  
    MsgBox "총" & r & "행 삭제"
   
End Sub

또다른 방법으로 하면 달랑 코드 한줄이면 된다.

코드설명 : Columns("C") 는 C열 전체를 선택하고, SpecialCells(4)는 공백인 셀인 경우 EntireRow.Delete 행전체를 삭제하라. 즉, C열에서 공백인 셀이 있으면 그 행을 삭제하라

Sub 빈행삭제()

    // C열에 빈셀이 존재하면 모두 지워라.
    Columns("C").SpecialCells(4).EntireRow.Delete
    '// (4)는 xlCellTypeBlanks
End Sub

시스템에서 가져온 데이터의 경우에는 공백처럼 보이는데 공백이 아니라면 그 행은 Asc (아스키코드) 값을 먼저 알아내야 한다.

VBA 로 복사하면 보통 값만 복사되는데 글자색도 같이 넣는 방법에 대한 팁은

Application.CutCopyMode = 0

Number 를 문자(Text)로 한번에 변경

Sub NumToText()
    Dim Temp As Double
    Dim Selection As Range

    Dim rngC as Range

    Set Selection = Range([B2], Cells(Rows.Count, "B").End(3))  '//마우스로 지정하려면 앞에 콤마를
     '// 마우스가 지정하는 것이 아니라 범위를 직접 지정하고 싶은 경우
     '// Cells(Rows.Count, "B").End(3) 은 B열의 값이 들어있는 마지막 셀을 의미함
    For Each rngC In Selection  '//마우스로 구간 설정한 곳 전부
        If Not IsEmpty(rngC.Value) And IsNumeric(rngC.Value) Then  '// 빈셀이 아니고 숫자이면
            Temp = rngC.Value
            rngC.ClearContents
            rngC.NumberFormat = "@"   '// 텍스트 서식으로
            rngC.Value = CStr(Temp)
            If Len(rngC.Value) < 13 Then  '//바코드가 총 13자리인거 같아서
                Select Case Len(rngC.Value)
                    Case 9: rngC.Value = "0000" & cell.Value
                    Case 10: rngC.Value = "000" & cell.Value
                    Case 11: rngC.Value = "00" & cell.Value
                    Case 12: rngC.Value = "0" & cell.Value
                End Select
            End If
        End If
    Next rngC
End Sub

색상을 이용한 결과값 구하기

색상을 이용하여 결과를 도출하고자 하는 경우가 있을 겁니다.

RGB 색상은 아니고, ColorIndex 값을 가진 색상입니다.

색상을 이용하려면 색상의 값을 먼저 알고 있어야 합니다.

Sub ShowColorIndex()
    Dim i As Integer, j As Integer
    For i = 1 To 4
        For j = 1 To 14
           Cells(j, (i - 1) * 2 + 1).Value = (i - 1) * 14 + j
           Cells(j, i * 2).Interior.ColorIndex = (i - 1) * 14 + j
        Next j
    Next i
End Sub

글자색을 구하려면 Font.ColorIndex 를 사용하고요.

배경색을 구하려면 Interior.ColorIndex 를 사용합니다.

둘다 모두 색상은 같습니다.

1 ~ 8 번까지는 색상이 우리가 아는 black. white, red, green, blue, yellow, magenta, cyan 입니다.

vbBlack, vbWhite, vbRed, vbGreen, vbBlue, vbYellow, vbMagenta, vbCyan 등으로 값을 써주면서 알아낼 수도 있습니다.

점수가 90점 이상이면 빨간색으로 하고 싶다면

rngC.Font.ColorIndex = 3 또는

rngC.Font.Color=vbRed

로 써주면 됩니다

'------------- 동일 글자 개수 구하는 함수 -----------------------

' rngAll 은 대상범위 이므로 A2:H16 같은 범위를 넣어주게 되는 거구요.

' Col 은 해당 셀을 의미

Function Color_Cnt(rngAll, Col) As Long
    Dim rngC As Range
    Dim i As Long
    For Each rngC In rngAll
        If rngC.Font.ColorIndex = Col.Font.ColorIndex Then
            i = i + 1
            Color_Cnt = i
        End If
    Next rngC
End Function

convert TextNumber to Number

보통 시스템에서 뽑아낸 자료를 보면 숫자인데도 텍스트로 된 경우가 있다.

이런 경우에 일일이 다 변경하는 건 정말 짜증나는 일이다.

VBA 코드를 알면 정말 간단하게 해결할 수 있다.

Sub Convert_TextNumber_To_Number()
    Dim rngC As Range
    Dim rngTarget As Range

    Set rngTarget = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)

    On Error Resume Next
    For Each rngC In rngTarget
        'If IsNumeric(rngC) Then rngC = Val(rngC) '// 에러 발생함

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

    Next rngC

    Set rngTarget = Nothing
    MsgBox "작업완료"
   
End Sub

TextNumber_to_Number.vbs

Text2Number.xlsm

이 코드를 엑셀에서 Alt + F11 키를 누르면 나오는 창에서 삽입 - 모듈 을 누르세요.

그러면 창이 나오는데 거기에 붙여넣기를 합니다

그곳에서 F5키를 누르면 실행되고 변경된 결과를 순식간에 확인할 수 있습니다.

InStr 를 이용한 셀 분리

이번에는 InStr 함수를 이용하여 셀 분리를 해보겠습니다.

범위 지정은 Range([A2], Cells(Rows.Count, "A").End(3))

구분자의 위치값을 반환하여 Left 함수 및 Mid 함수를 이용하여 원하는 구간을 잘라낼 수 있다.

Sub Cell_Split()
    Dim rngC    As Range   '// 한 Cell 씩 변하는 변수 지정
    Dim rngTarget As Range '// 대상 범위 지정변수
    Dim Split_L As Long    '// 구분자 위치 변수
    Dim deLimiter As String  '// 문자 구분자 변수
   
    Application.ScreenUpdating = False  '//화면 업데이트 (일시)정지
    Set rngTarget = Range([A2], Cells(Rows.Count, "A").End(3))
    '// A열 2행부터 값이 들어있는 마지막 행까지의 범위를 지정
  
    deLimiter = "/"       '//문자 구분자
    For Each rngC In rngTarget       
        Split_L = InStr(rngC.Value, deLimiter)
        '// InStr 함수 : 한 문자열 안에 특정 문자열이 처음으로 나타난 위치값을 반환       
        If Split_L > 0 Then
            rngC.Offset(0, 2).Value = Mid(rngC.Value, Split_L + 1, Len(rngC.Value) - Split_L)
            'rngC.Offset(0, 1).Value = Left(rngC.Value, Split_L - 1)  '// 구분자 앞부분을 표시
        End If
    Next rngC
    
    Set rngTarget = Nothing '// 변수 초기화
    Columns("C:G").AutoFit
End Sub

Cell_Split_VBA_instr.vbs

Cell_Split_VBA_instr.xlsm

rngC.Offset(0,2) 의 의미는 rngC 변수로부터 우측으로 2열 이동하라는 의미다.

만약 현재 셀에다가는 구분자의 왼쪽 값을 표시하고 싶다면

rngC.Offset(0,1).Value = Mid(rngC.Value, Split_L + 1, Len(rngC.Value) - Split_L)

rngC.Value = Left(rngC.Value, Split_L - 1)

로 변경해주면 된다.

우측에 표시될 값부터 먼저 표기한 이유는 위아래 순서를 변경해보면 알아요.

하지만, split 함수를 이용하면 훨씬 더 깔끔하게 해결할 수 있습니다.

첨부파일에 아래 코드를 추가로 포함시켜 놓았습니다.

Sub 셀분리()
    Dim rngC, rngAll As Range
    Dim v
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    Range([C2], Cells(Rows.Count, "D")).ClearContents   '// 표시할 영역 데이터 전부 지우기
    On Error Resume Next
    For Each rngC In rngAll
        v = Split(rngC, "/")
        Cells(rngC.Row, "C") = Trim(v(0))
        Cells(rngC.Row, "D") = Trim(v(1))
    Next rngC
    Set rngAll = Nothing
    Columns("C:G").AutoFit
End Sub

자체셀내의 중복여부 검사

엑셀 데이터가 많을 경우 기준열(Column)에 반복된 값이 얼마나 들어 있는지 검사하는 VBA 코드이다.

어떻게 처리되는지 확인은 F8키를 눌러서 순차적으로 실행되는 것을 확인하면 된다.

중복검사할 때 엑셀함수 CountIF 를 사용하듯이, VBA 에서도 엑셀에서 기본 제공하는 countif 함수를 이용할 수 있다. 이용하는 방법은 application.countif(범위,조건) 을 주면 된다.

rngC.Offset(0, rngT) = "중복" 와 같이 offset(행,열) 을 이용하기도 하지만,

Cells(행,열) 사용하면 직관적으로 이해하기 쉽다. Cells(rngC.Row,"D") = "중복" 이라고 하면 D열에 표시가 되는구나 하고 이해할 수 있다.

Sub 자체셀내의중복검사()
    Dim rngCh           '// 입력할 열 글자
    Dim rngC    As Range   '// 한 행(Row)씩 변하는 변수 지정
    Dim rngTarget As Range '// 대상 범위 지정변수
    Dim sRow As Integer '// 열을 직접 지정하지 않고 ActiveCell 기준으로 정하고자 할 때
    Dim rngT As Integer     '// 결과값을 표시할 위치 지정할 변수
    Dim oldTime As Single
       
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지, 이걸 지정해줘야 매우 빠르게 처리함

    oldTime = Timer
       
    rngCol = "C"   
    Set rngTarget = Range(Cells(2, rngCol), Cells(Rows.Count, rngCol).End(3))
    '// End(3) 은 End(xlUp) 으로 엑셀이 제공하는 총 행의 수로부터 위로 이동하라는 명령
    '// End(3)(2) 는 값이 있는 마지막행의 offset(1,0) 과 같은 의미로 바로 아래 행을 의미
    
    'ActiveCell.Select  '// ActiveCell 있는 셀 기준으로 중복검사를 할 경우
    'Set rngTarget = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
   
    rngT = 3  '// 검사하는 열로부터 몇번째 열에 중복이라는 글자를 표시할 것인가?
  
    For Each rngC In rngTarget
        rngC.Offset(0, rngT).ClearContents
        rngC.Font.Bold = False
        rngC.Offset(0, rngT + 1).ClearContents
       
        If Application.CountIf(rngTarget, rngC.Value) > 1 Then   '// 중복 개수가 2개 이상인 것만
            rngC.Font.Bold = True
            rngC.Offset(0, rngT) = "중복"
            rngC.Offset(0, rngT + 1) = Application.CountIf(rngTarget, rngC.Value)
        End If
    Next rngC
    
    Set rngTarget = Nothing     '// 변수 초기화
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"

End Sub

Countif_VBA-01.vbs

자료가 방대한 경우 어느정도 시간이 걸리는지 체크해보려고 넣었다

첨부파일은 텍스트파일이므로 수정해서 사용하시면 됩니다.

[VBA기초] 아스키코드 알아내기

해당 글자의 아스키코드 값이 어떻게 되는지를 알면 응용하여 구현할 때 편할거 같아서 포스팅 합니다.

글자를 입력하고 나서 매크로 단축키를 누르면 해당 아스키코드 값을 찾아주게 해봤습니다.

대문자 A가 65, Z가 90 이군요.

소문자 a가 97, z는 122 이군요.

숫자는 48 ~ 57까지 이군요. 문자열에서 숫자만 추출하도록 하려면 해당글자의 아스키코드로 변환한다음 하나 하나 비교하면서 해당숫자만 찾아내도록 하면 됩니다.

한글은 값을 추출해보니 전부 0보다 작더라구요.

아스키 코드 추출하는 함수가 Asc(글자) 라는 것만 알면 나머지는 쉽죠.

이번에는 아스키코드 숫자를 넣고 해당 글자를 찾아내는 걸 해봤습니다.

스페이스바는 아스키코드가 32 입니다.

해당 소스코드가 위와 같으니 직접 한번 해보시면 금방 이해하실 수 있습니다.

엑셀 VBA 참고하면 좋은 사이트 소개

엑셀 VBA 를 배우는데 도움이 되는 사이트를 소개합니다.

기본적인 개념을 설명이 잘 된 사이트는

엑셀러 권현욱님의 사이트 입니다. VBA 함수에 대한 기본 개념과 더불어 풍부한 예제가 많습니다.

단점이라면 풍부한 예제를 일일이 다운로드 받아서 봐야 한다는 점과 검색으로 쉽게 찾을 수 없다는 점입니다.

http://www.iexceller.com/

니꾸님 블로그는 정말 설명도 잘 되어 있어요.

차근 차근 배운다면 분명 많은 도움이 되실 겁니다. 그러나 엑셀로 하루종일 업무를 다루시는 분이 아니라면 차근 차근 배운다는 건 쉬운 일이 아니죠. 난 그냥 필요한 거 도움만 받으면 되니까 하시는 분들은 그냥 이 블로그에서 검색만 잘 눌러서 원하는 것이 있으면 활용하면 좋겠죠.

http://rosa0189.blog.me/

하나를 하더라도 최선을님의 블로그에도 좋은 정보들이 매우 많습니다.

2011년도 네이버 파워지식IN 으로 선정되신 분이십니다.

차근 차근 둘러볼 시간이 없다면 언제든지 검색을 눌러서 찾으면 원하는 걸 쉽게 찾을 수 있답니다.

http://blog.naver.com/heesung2003

엣마님 블로그

http://blog.naver.com/prologue/PrologueList.nhn?blogId=atmyhome

이상이 제가 아는 VBA 에 도움이 되는 사이트 입니다.

앞으로도 더 많은 정보를 알게되면 추가로 업데이트를 해두겠습니다.

출처 : 엑셀 하루에 하나씩 카페

1.해당 엑셀 시트에서 Alt+F11을 누르거나, 도구-매크로-'Visual Basic Editor"를 실행합니다.
2. VBA편집기가 나오면, 메뉴바에서 "삽입-모듈"을 실행합니다.
3. 하얀 백지화면이 나오면 아래 코드를 그대로 복사해다가 붙여넣습니다.
4. Alt+F11을 눌러 다시 원래의 워크시트로 돌아오십니다.
5. 일반 워크시트 함수와 똑같이 사용하시면 됩니다.

** 단점은 띄어쓰기가 된 걸 인식하지 못한다는 것이다.

    그래서 편법으로 " " 공백문자를 인식하도록 하는" "를 추가했다.

    두개의 조건문에 모두 넣으니 인식이 안되길래 한번씩 사용하는 걸로 하고 두번에 걸쳐서 자료를 추출했더니

    원하는 결과값이 얻어졌다. 심봤다!!!!!!!!!!

아래 함수를 직접 만들어주신 분께 정말 감사드립니다 

Function CutText(sText As String, Optional LanguageType As Integer = 1) As Variant

' ----------------------------------------------------------------------------------------

' 설명 : 인수로 전달한 sText 에서 LanguageType 의 값에 따라 지정한

'        형식의 텍스트만 분리해서 전달합니다.

'         LanguageType 의 사용값

'         1 : 숫자

'         2 : 영어 : 띠어쓰기 인식하도록 " " 추가하고, ' 인식하도록 추가

'         3 : 한글

'         4 : 한자

' 작성일 : 2005 / 9 / 20

' ----------------------------------------------------------------------------------------

    Dim sCut As String

    Dim sTMP As String

    Dim i As Integer

    Application.Volatile

    If LanguageType > 4 Then

        CutText = CVErr(xlErrNA)    '#N/A 오류를 반환

        Exit Function

    End If

    For i = 1 To Len(sText)  

        sCut = Mid(sText, i, 1)  

        Select Case sCut

            Case 0 To 9

                If LanguageType = 1 Then sTMP = sTMP & sCut

            Case "a" To "z", "A" To "Z", " ", "'"

                If LanguageType = 2 Then sTMP = sTMP & sCut

            Case "가" To "힣", "ㄱ" To "ㅎ", "ㅏ" To "ㅣ"

                If LanguageType = 3 Then sTMP = sTMP & sCut

            Case Else

                If LanguageType = 4 Then

                    If Asc(sCut) >= -13663 And Asc(sCut) < 0 Then sTMP = sTMP & sCut

                End If

        End Select  

    Next

    CutText = sTMP  

End Function