엑셀vba예제

[땡큐엑셀vba & 엑셀매크로] 정규식(regex)을 이용하여 값추출하기

땡큐엑셀 2020. 9. 9. 00:00

 

실행전

 

실행후

 

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

'엑셀에서 그림과 같이 특정 데이터를 다른 필드로 이동시키고 싶은데
'고수님들의 조언 부탁드립니다


'[시트소스]
'
'Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 값추출()
   
    
    For Each ea In Selection
    
        추출값1 = thankqStatus추출(ea.Value)
        추출값2 = thankqUserNam추출(ea.Value)
    
        ea.Offset(0, 1) = 추출값1
        ea.Offset(0, 2) = 추출값2
            
    Next
    
 
    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub








'정규식을 사용하여
'Status추출
Function thankqStatus추출(param1 As String)
    Dim strPattern As String: strPattern = "<STATUS>(.+)</STATUS>"
    
    Dim rex As Object
    Dim obj
    
    
    Set rex = CreateObject("vbscript.regexp")
    
    With rex
        .Pattern = strPattern
        .Global = True
        .ignorecase = True
    End With
    
    'If rex.test(param1) = True Then
        'thankqStatus추출 = rex.Execute(param1)(0)
    'End If


    If rex.test(param1) Then
        Set matches = rex.Execute(param1)
        GetStringInParens = matches(0).SubMatches(0)
    End If
    
    
    thankqStatus추출 = GetStringInParens

End Function


'정규식을 사용하여
'UserNams추출
Function thankqUserNam추출(param1 As String)
    Dim strPattern As String: strPattern = "<USERNAM>(.+)</USERNAM>"
    
    Dim rex As Object
    
    Set rex = CreateObject("vbscript.regexp")
    
    With rex
        .Pattern = strPattern
        .Global = True
        .ignorecase = True
    End With
    
    'If rex.test(param1) = True Then
    '    thankqUserNam추출 = rex.Execute(param1)(0)
    'End If

    If rex.test(param1) Then
        Set matches = rex.Execute(param1)
        GetStringInParens = matches(0).SubMatches(0)
    End If
    
    thankqUserNam추출 = GetStringInParens

End Function

정규식-문자추출-regexp-땡큐엑셀vba.xlsm
0.40MB