Vba 한글만 추출 - vba hangeulman chuchul

Text, 문자

(1784) 한글/영어/숫자만 추출하기 (엑셀 VBA 매크로)

이미 수없이 해본 기능이다. Like와 특정 문자들의 처음과 끝만 알면 어렵지 않다.

매크로 실행 전 A열에 데이터 입력                            매크로 실행 후 결과(한글/영문/숫자 추출) 

Option Explicit
Sub extract_each_Letter()

       Dim rngAll As Range                                       '전체(All)영역을 넣을 영역변수
    Dim rngC As Range                                        '각 셀(C)ell 을 넣을 영역변수
    Dim i As Integer                                             '셀의 문자길이만큼 반복할 변수
    Dim strEach As String                                     '추출한 각(Each) 문자 넣을 변수
    Dim strK As String                                          '한글(K)orean을 합쳐 넣을 변수
    Dim strE As String                                          '영어(E)nglish를 합쳐 넣을 변수
    Dim strN As String                                          '숫자(N)umber를 합쳐 넣을 변수

        Application.ScreenUpdating = False                 '화면 업데이트 (일시)정지
  
    Set rngAll = Range("A1", Cells(Rows.Count, "A").End(3))
                                                                       'A열 전체 데이터 영역을 변수에
    For Each rngC In rngAll                                  '전체영역 각 셀을 순환

For i = 1 To Len(rngC)                                '각셀의 문자 길이 만큼 반복
            strEach = Mid(rngC, i, 1)                        '셀의 각 문자를 변수에 넣음

                               If strEach Like "[가-힣]" Then                 '한글만 추출
                strK = strK & Mid(rngC, i, 1)                '추출한 문자를 합쳐감

                        ElseIf strEach Like "[a-zA-Z]" Then        '영어만 추출
                strE = strE & Mid(rngC, i, 1)                '추출한 문자를 합쳐감

                        ElseIf strEach Like "[0-9]" Then              '숫자만 추출            
                strN = strN & Mid(rngC, i, 1)                '추출한 문자를 합쳐감

            End If
        Next i

With rngC                                                  '각 셀에서
            .Offset(, 1) = strK                                    '한글 셀에 복사
            .Offset(, 2) = strE                                    '영어 셀에 복사
            .Offset(, 3) = strN                                    '숫자 셀에 복사
        End With

                strK = ""                                                    '재사용 위하여 초기화
        strE = ""                                                    '재사용 위하여 초기화
        strN = ""                                                    '재사용 위하여 초기화        
    Next rngC

    Columns("B:D").AutoFit                                   'B:D열 열너비 자동맞춤
    Set rngAll = Nothing                                        '개체변수 초기화(메모리 비우기)

End Sub