[정규식] 일정한 글자 길이만큼 잘라서 출력

http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=261860049

안녕하세요.

특정 열의 글자들을  지정한 갯수 만큼 분리하여 오른쪽 항목으로 넣는 매크로를 요청드립니다.

자세한 내용은 첨부된 엑셀을 보시면 금방 이해하실 수 있을 겁니다.

레코드 수가 너무 많아서 제가 만든 if문 복사로는 힘이 드네요.

레코드 수가 보통 10만개가 넘어서 드레그 하기에는 다소 문제가 있습니다.

최대 글자수는 100자 이하이므로 10글자씩 10항목으로 자를 수 있습니다.

도와주세요.

Sub Macro()
 
    Dim p As Object, M As Object
    Dim v$(), i%
    Dim rnG As Range, rngData As Range
    
    '기존자료삭제
    Range("B4").CurrentRegion.Offset(1, 2).ClearContents
    
    '글자를 분리할 데이터 영역
    Set rngData = Range("C5", Cells(Rows.Count, 3).End(3))
    
    '정규식 선언
    Set p = CreateObject("VBscript.regexp")
    With p
        .Global = True  '셀 내 모든 글자
        .Pattern = ".{1,10}"    '최소1글자, 최대 10글자의 패턴을 가짐
        
        For Each rnG In rngData
    
            If .test(rnG) Then  '셀에 1자 이상의 글자가 있으면
                Set M = .Execute(rnG)   '정규식 실행
                
                ReDim v(M.Count - 1)    '배열 재선언 : 10개씩 나눈 글자 그룹의 수만큼
                
                For i = 1 To M.Count    '10개씩 나눈 글자를 배열에 삽입
                    v(i - 1) = M.Item(i - 1)
                Next i
                
                rnG.Offset(, 1).Resize(, M.Count) = v   '글자를 셀에 출력
                
            Else    '셀에 글자가 없으면 빈내용 출력
                rnG.Offset(, 1) = ""
            End If
            
        Next rnG
    End With
    
End Sub
 

글자 분리 매크로 요청.xlsm