[& Chronicle] 일치하는 패턴 개수

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

A행에는 패턴이 나와있고 C행에는 데이터가 나열되어 있습니다.

A행의 패턴이 C행에 몇 개나 있는지 파악하는 질문입니다.

Chronicle님은 PHONETIC 함수와 이름관리자를 이용하여 해결하였습니다. - http://blog.naver.com/asaph16/220999094014

매크로의 해결방법에는 여러가지가 존재합니다만

역시 이런 류는 정규식이 편합니다.

정규식을 적용하기 위해 A행과 C행을 문자열로 변환하여 준 다음 일치하는 패턴의 개수를 구해주면 됩니다.

Sub Macro()
 
    Dim MyPattern As String
    Dim PatternData As String
    
    '패턴과 문자를 하나의 문자로 변환합니다.
    MyPattern = To1DArray(Range("A5").CurrentRegion)
    PatternData = To1DArray(Range("C1").CurrentRegion)
    
    '정규식을 생성하여 일치하는 패턴 개수를 찾아냅니다.
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = MyPattern
        
        If .test(PatternData) Then
            Range("E2") = .Execute(PatternData).Count
        Else
            Range("E2") = 0
        End If
    End With
 
End Sub
 
Function To1DArray(WhichData As Range) As String
    '1차원 배열인지 2차원 배열인지 체크하여 문자열로 변환합니다.
 
    Dim tmp As Variant
    Dim wkF As WorksheetFunction
    Dim i As Integer
    
    Set wkF = WorksheetFunction
    tmp = wkF.Transpose(WhichData)
    
    On Error Resume Next
    
    i = UBound(tmp, 2)
    
    Select Case Err.Number
        Case Is > 0
            To1DArray = Join(tmp)
        Case Else
            To1DArray = Join(wkF.Transpose(tmp))
    End Select
        
    On Error GoTo 0
    
End Function