일정 기준으로 텍스트 나누기

지식인에 올라온 글.

A열을 C, D, E열로 구분해달라는 내용.

기준은 알 것같은데 코드로 짜려니 막상 오래 걸렸다.

1. [ 가 나올 때까지 글자를 합쳐서 배열에 넣고

2. 한 셀의 작업이 끝나면 C 열부터 붙이기 작업을 하였다.

이 정도면 배열 감각은 익힌 듯

Sub fnDevide()
 
    Dim rngArea As Range, rngCell As Range
    Dim rngPaste As Range
    Dim vrColor() As String
    Dim strText As String, strChar As String
    Dim j As Integer, vr As Integer
    Dim cntC As Integer
        
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '기존값 삭제, 데이터영역 설정
    Range("C3").CurrentRegion.Clear
    Set rngArea = Range("A3", Cells(Rows.Count, "A").End(xlUp))
    
    'A열을 순환하며 작업
    For Each rngCell In rngArea
        For j = 1 To Len(rngCell)
            
            '두번째 [가 나올 때까지 글자 합치기
            strChar = Mid(rngCell, j, 1)
                            
            If strChar = "[" And Len(strText) > 1 Then
                ReDim Preserve vrColor(vr)
                vrColor(vr) = Trim(strText)
                vr = vr + 1
                strText = ""
            End If
            
            strText = strText & strChar
            
            '구분이 셀 글자수와 같으면 배열 종료
            If j = Len(rngCell) Then
                ReDim Preserve vrColor(vr)
                vrColor(vr) = Trim(strText)
                vr = 0
                strText = ""
            End If
        Next j
        
        '나누기 된 값을 옆 셀에 뿌리기
        For j = 1 To UBound(vrColor) + 1
            rngCell.Offset(, j + 1) = vrColor(j - 1)
        Next j
        ReDim vrColor(vr)
    Next rngCell
    
    '나누기 된 표 제목 입력
    Set rngPaste = Range("C3").CurrentRegion
    cntC = rngPaste.Columns.Count
    For j = 1 To cntC
        With Range("C2").Offset(, j - 1)
            .Value = "구분" & j
            .Interior.Color = vbYellow
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
        End With
    Next j
    
    '나누기 된 표 서식 설정
    With rngPaste
        .Borders.LineStyle = xlContinuous
        .Columns.AutoFit
        .Font.Size = 10
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

나누기.xlsm