Split, Replace, Trim 활용해서 카톡 대화내용 필요한 부분 추출하기

카톡으로 발주를 매일 받는건이 있어서 만들었던 매크로 입니다. 현재도 쓰고 있구요.
저의 상황에 맞춰서 만든거라 참고용으로 보시고 필요하신 부분 참고하시라고 올려봅니다.
카톡 대화창에서 대화내용을 우클릭해서 복사한뒤 엑셀에 붙여넣기를 하면

 

[대화명] [시간] 내용

 

이런식으로 나오게 되는데 여기서 내용만 뽑아내고 내용에서 필요없는 부분을 없애고, 원하는 형식으로 변경해주는 코드입니다.

 

Sub KakaoMessageFiltering()

    Dim i As Long, j As Long                                    '반복구문에 사용할 변수
    Dim strU As String, strUF As String                           '문자를 합쳐갈(U)nion 변수
    Dim strEach$, strK$, strL$                                   '문자를 넣을 변수
    Dim varS() As String                             '전체영역을 넣기위한 variant형 string 변수
    Dim r As Integer, c As Integer
   
    Application.ScreenUpdating = False                  '화면 업데이트 (일시) 정지
   
    strU = Split(Cells(1, 1), "]")(2)               '2번째 "]" 뒤의 문자를 변수에
    strUF = Replace(Trim(strU), ".", "")            '앞뒤 공백과 .을 제거하고 변수에 넣음
    varS = Split(strUF, " ")                        'B셀을 공백으로 쪼개서 배열에 넣음
    r = 2: c = 1
    
    If Range("A2") <> "" Then                         '기존 데이터가 있다면
        Range("A2", Cells(Rows.Count, "O")).ClearContents '기존 데이터 삭제
    End If

    For i = LBound(varS) To UBound(varS)            '배열 하한선에서 상한선까지 반복
        If varS(i) <> "" Then                       '공백이 아닐경우
            For j = 1 To Len(varS(i))               '배열의 글자수만큼 반복
                strEach = Mid(varS(i), j, 1)        '배열의 각 문자를 변수에 넣음
                
                If strEach Like "[a-zA-Z가-힣()]" Then           '한글&영어만 추출
                    Do                                         '실행
                        strK = strK & Mid(varS(i), j, 1)       '추출한 문자를 합쳐감
                        j = j + 1                              '문자위치 1씩 늘려감
                    Loop Until Not Mid(varS(i), j, 1) Like "[a-zA-Z가-힣()]" '지정문자(영어,한글) 아닐때까지 반복
                    
                    '"키로"를 "kg"으로 변환
                    If strK = "키로" Then
                        Cells(r, c) = "kg"
                    Else
                        Cells(r, c) = strK
                    End If
                    
                    '"만원" or "천원"일 경우
                    If strK = "만원" Or strK = "천원" Then
                        Cells(r, c - 2).Value = CStr(Cells(r, c - 2)) + "(" + CStr(Cells(r, c - 1)) + strK + ")"
                        Cells(r, c - 1) = 1
                        Cells(r, c) = "봉"
                    End If
                    
                    c = c + 1
                ElseIf strEach Like "[0-9]" Then                     '숫자만 추출
                    Do                                         '실행
                        strK = strK & Mid(varS(i), j, 1)       '추출한 숫자를 합쳐감
                        j = j + 1                              '문자위치 1씩 늘려감
                    Loop Until Not Mid(varS(i), j, 1) Like "[0-9]" '숫자가 아닐때까지 반복
                    
                    Cells(r, c) = strK
                    c = c + 1
                    Cells(r, c + 1) = "추가"
                Else
                    MsgBox "잘못된 문자열이 포함되어 있습니다. (" & strEach & ")", vbCritical
                    Exit Sub
                End If
                j = j - 1
                strK = ""       '초기화
            Next j
            r = r + 1
            c = 1
        End If
    Next i

End Sub

 

이런 카톡을 받았을 경우, 우클릭 복사해서 A1셀에 붙여넣기 한뒤 매크로를 실행시키면 

 

이런식으로 변환이 되는 코드입니다.