고급 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, " ")(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을 구할 수 있게 됩니다.

[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

좌우공백 제거

자료 정리를 하다보니 공백제거 하는게 정말 중요하다는 걸 느끼고 있어서 적어봅니다.

자료를 정리해서 서버 DB에 업로드하는데 업로드할 때 중복여부를 체크합니다.

분명히 DB에 있는 자료인데 없는 자료라고 인식하여 중복 등록되는 현상이 생기네요.

원인이 뭘까하고 열심히 파악 해봤더니 좌우 공백이 있는채 올라가거나, 유령문자, 쿼터(')처리 때문에 중복검사를 하면 중복이 제대로 검사가 안되더라구요.

누구나 다 아는 쉬운것에서 발생하는 사소한 실수가 엄청난 결과를 초래하기도 한다는 걸 다시금 깨닫게 되어 공백제거를 할 때 몇개나 공백이 제거 되었는지, 그리고 길이를 한번 파악해보려고 적어본 겁니다.

인터넷상에서 자료를 긁어온 경우나 시스템에서 받아온 자료에 유령문자가 있을 수 있습니다.

Sub 좌우공백제거()
    Dim rngC As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range        '// 전체 데이터 영역을 넣을 변수
    Dim i As Integer          '// 중복 개수를 카운트할 변수
   
    i = 0
    Set rngAll = Range([C2], Cells(Rows.Count, "C").End(3))   '// 공백제거 검사를 할 셀을 C열로 지정
    Range([H1], Cells(Rows.Count, "I").End(3)).Offset(1).Clear   '// 공백제거 표시할 열이 설정된 값 초기화
 
    For Each rngC In rngAll
        If rngC <> Trim(rngC) Then
            rngC.Offset(0, 5) = Len(rngC)    '// 검사하는 셀에서 우측으로 5번째에 길이를 표시하라
            rngC = Trim(rngC)   '// 좌우 공백 제거
            rngC.Offset(0, 6) = Len(rngC)   '// 검사하는 셀에서 우측으로 6번째에 공백제거한 길이를 표시하라
            i = i + 1
        End If
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & i & "개 공백제거"

End Sub

글꼴 정리

글꼴을 깔끔하게 정리하고 싶을 때 사용하면 됩니다.

AcitveCell 이란 현재 커서가 있는 셀을 말합니다. 현재 커서가 있는 셀을 기준으로 해서 정리를 합니다.

Sub 글꼴정리()
    Dim rngTarget As Range
    Dim rngC As Range
 
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    ActiveCell.Select
    Set rngTarget = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
 
    For Each rngC In rngTarget
        With rngC
           .Font.Name = "Tahoma"
           .Font.Size = 11
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
        With rngC.Offset(0, 1)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
        With rngC.Offset(0, 2)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
    Next rngC
    Set rngTarget = Nothing '// 변수 초기화
    'MsgBox "작업 완료"
End Sub

셀 병합하기 및 셀 병합 해제

Sub MergeCells()
    Dim rngAll As Range     '// 선택영역 전체 범위 변수

    Dim iRow, iCol As Integer   '// 행, 열의 변수

    Dim rCnt As Integer      '// 병합할 셀의 크기 지정 카운트
      
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
    Application.DisplayAlerts = False   '// 화면경고 중지
  
    For iCol = 1 To rngAll.Columns.Count
        For iRow = 1 To rngAll.Rows.Count
            If rngAll.Cells(iRow, iCol) = rngAll.Cells(iRow + 1, iCol) Then
                rCnt = rCnt + 1
            Else
                Range(rngAll.Cells(iRow, iCol), rngAll(iRow - rCnt, iCol)).Merge
                rCnt = 0
            End If
        Next
    Next
    Application.DisplayAlerts = True    '// 화면경고 복원
End Sub

Sub unMerge()
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
   
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
    rngAll.Cells.MergeCells = False   '// 범위의 셀 전체를 선택해서 병합 해제   
End Sub

첨부한 VBA 코드는 셀 병합, 병합 해제, 윗셀의 값으로 채우기, 병합해제 및 값으로 채우기 에 대한 VBA 코드입니다.

이 코드 하나면 간단하게 셀 병합 해제는 편리하게 이용할 수 있을 겁니다.

수정해서 사용할 곳은 위 주황색 부분의 범위구간 설정하는 곳입니다.

나머지는 그대로 이용하면 됩니다.

Cell_Merge_unMerge.vbs

빈셀일 경우 윗셀의 내용으로 채우기

엑셀 작업을 하다보면 셀을 병합하거나 해제 등의 작업을 하게 됩니다.

이럴 때 편리하게 사용할 수 있는 간단한 VBA 코드입니다.

수정할 부분은 분홍색 구간범위 입니다.

Sub BlankCell_and_Fill()
'// 빈셀일 경우 윗셀의 내용으로 채우기
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
   
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
   
    For Each rngC In rngAll     '// 선택 영역을 순환
        If IsEmpty(rngC) Then       '// 선택된 셀이 비어있다면
            rngC.Value = rngC.Offset(-1, 0).Value   '// 윗셀의 내용을 넣어라
        End If
    Next rngC
End Sub

셀 병합 해제하고 같은 값으로 채우기

아래 VBA 코드는 셀병합을 해제할 구간을 선택하고 셀병합전 값으로 채웁니다.

구간범위 설정하는 곳만 상황에 맞게 변경해주면 됩니다.

Sub unMerge_and_Fill()
    Dim rngC As Range          '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range         '// 선택영역 전체 범위 변수
   
    Application.ScreenUpdating = False       '// 화면 업데이트 중지
    Set rngAll = Range([B2], Cells(Rows.Count, "C").End(3))
   
    For Each rngC In rngAll              '// 선택 영역을 순환
        If rngC.MergeCells Then         '// 선택 셀이 셀병합 되어 있다면
            With rngC.MergeArea            '// 셀 병합된 area를
                .UnMerge                   '// 셀 병합 해제
                .Value = rngC              '// 셀 병합 풀린영역 셀 병합전 값으로 채움
            End With
        End If
    Next   
    MsgBox "처리완료"
End Sub

첫문자열 공백제거

네이버지식인에 나온 질문을 테스트해보려고 복사해서 붙여넣기를 했더니

이렇게 앞부분이 공백으로 나오는 경우가 있습니다.

trim 함수 이용하여 지워도 절대 지워지지 않더군요. trim 함수는 문자열의 앞뒤의 스페이스바 공백 (아스키값 32)만 지우는 겁니다.

Sub asc_value()
    Dim rngC As Range
    Dim rngAll As Range
    Dim temp As Variant
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
    For Each rngC In rngAll
        temp = Asc(Left(rngC, 1))
        MsgBox temp
    Next rngC
End Sub

아스키 값을 알아냈다니 63 이라고 나오네요..

그래서

Sub 문자열변경()
    Dim rngAll As Range   
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
    rngAll.Replace What:=Chr(63), replacement:=""
End Sub

로 했더니....

이렇게 다 지워져 버리네요.. 알고보니 아스키값 63 은 ? 이더군요..

엑셀에서 ? 된 것은 모두를 뜻하여 전부 지워버린 거네요..

그래서 좀 불편하더라도

Sub 첫문자열공백제거()
    Dim rngAll As Range
    Dim rngC As Range
    Dim sName  As String
  
    ActiveCell.Select     '// 현재 커서가 있을 셀 선택
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
  
    For Each rngC In rngAll
        sName = Left(rngC, 1)     '// 첫번째 문자열 추출
        If Asc(sName) = 63 Or Asc(sName) = 32 Then    '//스페이스바의 아스키 값은 32
            rngC = Mid(rngC, 2, Len(rngC))       
        End If
    Next rngC  
End Sub

코드를 사용해서 첫문자열 공백을 제거했습니다.

아스키 코드값을 알아내도 잘못 사용하면 데이터가 원하지 않는 결과를 얻을 수도 있다는 걸 알았습니다.

여러행 한꺼번에 삭제

가장 간단하게 여러행을 삭제하는 방법은 Range 범위를 주고 행을 삭제하는 것입니다.

메모리가 부족하다는 메시지가 나와서 아래 방법을 써봤는데 알고 보니까 엑셀 파일이 문제가 있었나 봅니다.

새로운 파일을 생성하고 데이터만 복사해서 아래 VBA 코드를 실행했더니 금방 금방 파일이 지워지더군요.

Sub 여러행삭제()
    Range([a2], [a1000]).EntireRow.Delete
End Sub

또다른 방법은

삭제할 행의 수를 입력받아서 지우는 방법입니다.

Cells(행,열) 이므로 Cells(Counter,1) 이라는 의미는 행의 수는 가변으로 받고, 열은 1 즉 A열을 의미합니다.

Sub 여러행삭제()
    Dim i As Integer
    Dim Counter
   
    Counter = InputBox("삭제할 행의 개수를 입력하세요")
    Range([a2], Cells(Counter, 1)).EntireRow.Delete
End Sub

범위(Range)를 주고 그 범위의 행 전체를 모두 삭제

Range(Cells(6, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
// 의미 분석을 해보면 ....

// Cells(행,열) 이며, Cells(6,"A") 라는 것은 6번째행, 열은 A열 이라는 것임. 다르게 표현하면 Cells(6,1)

// 쓰는 사람에 따라 Cells(6,1)을 선호하는 분도 있음. 전 어떤 열인지 파악하기 좋게 영문표기를 선호

// Cells(Rows.Count, "A") 에서 Rows.Count 는 엑셀이 제공하는 최고의 행수를 의미

[VBA기초] 괄호 제거한 문자열 추출

괄호를 제외한 문자열을 일일이 수작업하는 것은 너무 번거로울 수가 있습니다.

이럴 경우에 아래 VBA 코드를 이용하면 매우 편리합니다.

부연 설명을 드리자면

    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
이 부분은 현재 커서거 있는 셀을 기준으로 그 열 전체를 선택하라는 의미입니다.

만약 B열 등 특정한 열만 선택하고자 한다면

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

이라고 범위를 지정하면 됩니다.

For Each 문은 정해진 구간을 무조건 반복하라는 의미입니다.

InStr 함수를 이용하여 (가 시작되는 위치를 반환하고, )가 시작되는 위치를 반환합니다.

이제 Left 함수와 Mid 함수를 이용하여 원하는 구간만 추출하고 & 로 묶어주고, 결과를 어디에 뿌릴 것인가만 정해주면 됩니다.

Sub 괄호제외한문자열추출()
    '// 문자열 중 ()괄호 밖의 문자열만 따로 추출하기
    Dim rngAll As Range '// 해당 영역을 변수로 지정
    Dim rngC As Range '// 셀을 지정
    Dim startChk As Byte '// (시작위치 변수 지정
    Dim endChk As Byte '// )끝위치 변수 지정
    Dim tmpString As String '// 추출 문자열 임시 저장 변수
 
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
 
    For Each rngC In rngAll
        'rngC.Value = Trim(rngC.Value)
        startChk = InStr(rngC.Value, "(")
        endChk = InStr(rngC.Value, ")")
     
        '// ()를 제외한 문자열 추출
        tmpString = Left(rngC, startChk - 1) & Mid(rngC.Value, endChk + 1, Len(rngC) - endChk)
        rngC.Value = tmpString  '// 같은 열에 덮어쓰기
        'rngC.offset(0,1).Value = tmpString '// 바로 옆에 열에 기록하기   
    Next rngC
    Set rngAll = Nothing
    MsgBox "완료"
End Sub

 셀 중앙정렬

셀을 중앙정렬하는 VBA는 굳이 필요 없을 수도 있습니다.

Sub 셀중앙정렬()   
    ActiveCell.Select   '// 현재 커서가 있는 셀
    Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3)).HorizontalAlignment = xlCenter
    MsgBox "완료"
End Sub

이제 커서를 위 VBA 코드 사이에 두고 F5키를 누르세요..

VBA 날짜, 시간, 시간대 추출

날짜와 시간을 다루는 함수는 굳이 VBA를 사용하지 않아도 편리하게 원하는 값을 추출이 가능합니다.

시간만 추출하는 함수는 = HOUR(날짜시간함수셀) 을 하면 시간이 추출됨

시간과 분을 16:36 이렇게 표기하고 싶다면

= TEXT(HOUR(날짜시간함수셀),"00") & ":" & TEXT(MINUTE(날짜시간함수셀),"00")

로 함수조건을 주면 됩니다.

Sub 날짜추출()
    Dim rngC As Range
    Dim rngAll As Range
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    'Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
   
    For Each rngC In rngAll
        rngC.Offset(0, 1) = Left(rngC, 10)
        rngC.Offset(0, 1).NumberFormat = "yyyy-mm-dd" '// 셀서식 날짜형식 지정
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "완료"
End Sub

Sub 시간추출()
    Dim rngC As Range
    Dim rngAll As Range
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    'Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
   
    For Each rngC In rngAll

        rngC.Offset(0,2).NumberFormat = "General"

        rngC.Offset(0,2) = Hour(rngC) & ":" & Minute(rngC)
        'rngC.Offset(0, 2).NumberFormat = "hh:mm:ss" '// 셀서식 시간형식 지정
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

Sub 시간대추출()
    Dim rngC As Range
    Dim rngAll As Range
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    Set rngAll = Range([D2], Cells(Rows.Count, "D").End(3))
    'ActiveCell.Select
    'Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
   
    For Each rngC In rngAll
        rngC.Offset(0, 3) = Hour(rngC)
        'rngC.Offset(0, 3).NumberFormat = "hh" '// 셀서식 시간형식 지정
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

---------------------------------------------------------------------------------------

파일명에 날짜 포함

fName = "ShopData_" & Format(Date, "yyyy-mm-dd") & ".csv"

[VBA기초] 숫자만 추출

Sub 숫자만추출()
    Dim strText As String   '// 각 문자를 넣을 변수
    Dim strU As String      '// 문자를 합쳐갈 변수
    Dim i As Integer        '// 전체 문자길이 만큼 반복할 변수
    Dim rngC As Range       '// 각 Line 변수
    Dim rngAll As Range     '// 전체 범위 지정
    Dim oldTime As Single   '// 걸린 시간 구하는 변수 지정
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    '// A2 셀부터 A열의 마지막 셀까지
       
    For Each rngC In rngAll
        For i = 1 To Len(rngC)                      '// 전체 문자길이 만큼 반복
                strText = Mid(rngC, i, 1)           '// 각 숫자를 추출해 변수에 넣음
                If strText Like "[0-9]" Then        '// 문자가 숫자일 경우
                    strU = strU & Mid(rngC, i, 1)   '// 각 숫자를 합쳐감
                End If
        Next i
        rngC.Offset(0, 1) = strU        '// 추출한 값을 기록
        strU = ""   '// 값을 기록했으니까 초기화가 필요함
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"

End Sub

가져다 사용할 경우 보라색 부분만 수정하여 사용하면 됩니다.

범위구간을 지정하는 곳과, 기록할 필드를 지정하는 것입니다.

Offset(0,1) 은 현재 셀의 오른쪽 셀에 기록하겠다는 의미

만약 오른쪽 두번째 열에 기록하겠다고 하면 Offset(0,2) 가 됨

Numeric_extract.vbs

[VBA기초] 영문자만 추출

Sub 영문만추출()
    Dim strText As String   '// 각 문자를 넣을 변수
    Dim strU As String      '// 문자를 합쳐갈 변수
    Dim i As Integer        '// 전체 문자길이 만큼 반복할 변수
    Dim rngC As Range       '// 각 Line 변수
    Dim rngAll As Range     '// 전체 범위 지정
    Dim oldTime As Single   '// 걸린 시간 구하는 변수 지정
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    '// A2 셀부터 A열의 마지막 셀까지, 빨간색 A는 D로 변경하면 A2 에서 D열의 마지막까지가 변수 범위가 됨
       
    For Each rngC In rngAll
        For i = 1 To Len(rngC)              '// 전체 문자길이 만큼 반복
                strText = Mid(rngC, i, 1)   '// 각 문자를 추출해 변수에 넣음
                If Asc(UCase(strText)) >= 65 And Asc(UCase(strText)) <= 90 Then   '// 문자가 영문일 경우
                    strU = strU & Mid(rngC, i, 1)    '// 각 문자를 합쳐감
                End If
        Next i
        rngC.Offset(0, 1) = strU        '// 추출한 값을 기록
        strU = ""   '// 값을 기록했으니까 초기화가 필요함
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"

End Sub

그대로 가져다 활용할 경우에는 보라색만 변경해서 사용하면 됩니다.

즉 범위를 어디까지 지정할 것인가, 어디에 기록을 할 것인가 하는 부분입니다.

Eng_extract.vbs

VBA 요일 구하기

엑셀을 다루다보면 날짜에 해당하는 요일을 구해야 할 때가 있습니다.

해당 날짜의 요일이 뭔지 금방 찾아주는 VBA 코드입니다.

Sub 요일구하기()
    Dim rngC As Range
    Dim rngAll As Range
       
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))  '//B2 셀부터 값이 있는 B열마지막 셀까지 범위
   
    For Each rngC In rngAll

   '// rngC는 현재 셀, rngAll 은 B열 구간범위, rngC가 for문으로 하나 하나 증가하면서 실행

        'rngC.Offset(, 1) = Application.WorksheetFunction.Text(rngC, "ddd")    '// 영문으로 날짜 반환
        rngC.Offset(, 1) = Format(rngC, "aaa")  '// 월, 화, 수 의 날짜 구하기
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
End Sub

엑셀메모 한꺼번에 지우기

엑셀창에서 Alt + F11 누르면 나오는 창에서 [삽입] - [모듈] 선택하세요.

그런 다음에 아래코드를 입력하세요..

Sub 메모삭제()
    Range("A2:D100").ClearComments
    '// 범위 셀 구간이 A2 에서 D100 이라는 의미이므로 상황에 맞게 수정
End Sub

이제 커서를 위 VBA 코드 사이에 두고 F5키를 누르세요..

그러면 메모 지워집니다..

엑셀의 ActiveSheet 에 있는 메모가 지워지는 겁니다.

열 자동 맞춤

Sub 자동맞춤()

Columns("A:AH").AutoFit  '// A열에서 AH열까지 열 자동 맞춤

Columns("A:B").HorizontalAlignment = xlCenter  '// A열,B열 가운데 정렬
Rows(1).HorizontalAlignment = xlCenter  '// 1행만 가운데 정렬

End Sub

위 코드만으로 열 맞춤을 자동으로 간단하게 해결됩니다.

방법은 엑셀이 띄워진 상태에서 Alt + F11 키를 눌러서 새로운 창이 뜨면 [삽입] - [모듈] 을 누릅니다.

나오는 창에다가 위의 코드를 입력합니다.

그런 다음에 F5키를 누릅니다.

그러면 엑셀의 현재 활성화된 Sheet에 있는 열 자동 맞춤이 됩니다.

글꼴 변경

열기준으로 크기와 글꼴을 변경하고 싶을 때 지정하는 간단한 VBA 코드입니다.

Sub 글꼴정리()
    Dim rngTarget As Range
    Dim rngC As Range
   
    Application.ScreenUpdating = False      '//화면 업데이트 (일시)정지
    ActiveCell.Select        '// ActiveCell 이 있는 셀 아래를 글꼴 변경
    Set rngTarget = Range(Cells(ActiveCell.Row, "A"), Cells(Rows.Count, "A").End(3))
   
    For Each rngC In rngTarget
        With rngC
           .Font.Name = "Tahoma"
           .Font.Size = 11
        End With
        With rngC.Offset(0, 1)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
        End With
        With rngC.Offset(0, 2)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
        End With
    Next rngC
    Set rngTarget = Nothing '// 변수 초기화  
    MsgBox "작업 완료"
End Sub

VBA 데이터 옮기기

옮기고 싶은 데이터를 옮기는 방법은 다양하게 있습니다.

따라서 본인이 옮기고 싶은 과정을 자동 매크로를 이용하여 VBA 코드가 뭔지 알아내보는 것도 좋습니다.

아래 빨간색 부분이 자동 매크로를 통해서 알아낸 부분입니다.

현재 커서가 있는 셀을 기준으로 해서 셀을 선택해서 잘라내고, 왼쪽으로 한칸, 아래로 한칸 이동한 다음에 복사한 것을 붙여넣기 합니다.

행 삽입하는 VBA 코드를 약간만 수정하면 되므로 파일 첨부는 하지 않습니다.

Sub Shift_Data()
    Dim Counter
    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.Value = Trim(ActiveCell.Value)   '// ActiveCell 의 빈공백 제거
        If ActiveCell.Value <> "" Then   '// 현재 셀이 공백이 아니면
            With ActiveCell
                Selection.Cut            '// 선택된 셀/구간을 잘라라
                ActiveCell.Offset(1, -1).Range("A1").Select
                ActiveSheet.Paste
            End With
            Counter = Counter - 1
            ActiveCell.Offset(1, 1).Select  '// 셀을 옮기고 싶은 위치를 지정
        Else
            ActiveCell.Offset(1).Select  '// 1행 아래로 이동
        End If
    Next i
    MsgBox "처리완료"
End Sub

또다른 방법인데, 이 방법이 훨씬 더 간결하고 간단하게 옮기는 방법입니다.

복사할 구간 범위를 설정하고 다른 시트로 복사하는 방법입니다.

Sub Copy_Data()
    Dim rngC As Range
    Dim rngAll As Range

    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([A2], Cells(Rows.Count, "E").End(3))
     '// 추출한 데이터가 있는 셀 범위 지정
        
    With Worksheets("data")  '// 해당 시트명 직접 입력
         rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
         '// 구간범위 전체를 복사하여 지정한(data) 시트의 마지막 값이 들어있는 아래행에 복사하라

           '// Cells(행, 열) 개념을 생각하면 cells(행,1) 의 의미는 첫번째 열 즉 A열을 의미
    End With
            
    MsgBox "처리완료"
End Sub

VBA 빈행 삽입하기

커서가 있는 위치부터 한행씩 빈행을 삽입하는 VBA 코드 입니다.

위 그림을 보면 중간에 빈행이 있는 경우도 있고 연달아 데이터가 입력된 경우도 있을 겁니다.

일정하게 한행씩 빈행을 삽입하는 코드로 작성을 했습니다.

이미 한행씩 빈행이 삽입되어 있는 경우에는 변화가 생기지 않습니다.

VBA_Insert_blankrow.vbs

Sub InSert_BlankRow()
    Dim Counter
    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   '// Loops through the desired number of rows.
        ActiveCell.Value = Trim(ActiveCell.Value)   '// ActiveCell 의 빈행백 제거       
        If ActiveCell.Value <> "" And ActiveCell.Offset(1).Value <> "" Then

             '// ActiveCell 과 바로 아래 셀이 둘다 공백이 아니면 ActiveCell 아래 행을 하나 삽입하라
            ActiveCell.Offset(1).EntireRow.Insert
            Counter = Counter - 1
            ActiveCell.Offset(2).Select   '// 2행 아래로 이동
        ElseIf ActiveCell.Value = "" And ActiveCell.Offset(1).Value = "" Then

               '// ActiveCell 과 바로 아래 셀이 둘다 공백이면 ActiveCell 아래 행을 삭제하라
            ActiveCell.Offset(1).EntireRow.Delete
        Else
            ActiveCell.Offset(1).Select  '// 1행 아래로 이동
        End If   
    Next i
End Sub

질의가 있어서 내용을 추가합니다. 몇번을 실행하는지 여부를 i, d 를 추가해서 표시하도록 했습니다.

Sub 행일괄삽입()
    Dim C As Range
    Dim rngtarget As Range
    Dim i As Double, d As Double
   
    Set rngtarget = Range("B1", Cells(Rows.Count, "B").End(3))
    i = 0
    d = 0
   
    For Each C In rngtarget
        C.Select
        If C.Value <> "" And C.Offset(1).Value <> "" Then
            C.Offset(1).EntireRow.Insert
            i = i + 1
       
        ElseIf C.Value = "" And C.Offset(1).Value = "" Then
            C.Offset(1).EntireRow.Delete
            d = d + 1
        Else
       
        End If
    Next C
   
    MsgBox "d=" & d & " i=" & i
End Sub