[VBA] 정규식으로 유일값 찾아내기

이문제는 정규식 패턴을 입맛대로 변경하면서 패턴과 불일치한 유일값을 찾아내는 코드이다.

이문제를 풀기 위해서는 크게 두가지로 상황을 생각할 수 있다.

1. 패턴이 하나만 일치할때

2. 패턴이 두개 일치할 때

 

어느 하나로 문제를 풀려고 하면 의도한 대로가 아닌 반드시 에러가 생길것이다.

본인은 이 예외 상황을 풀기 위해 사용자함수를 사용하여 예외처리 하였다.

 

퍼포먼스는 맘에 드는데 코드 길이가 영 맘에 안든다..ㅜ.,ㅡ

 

Option Explicit
Sub 특이점_찾아내기()

    Dim Reg As Object: Set Reg = CreateObject("Vbscript.regexp")    '= 정규식 선언
    Dim rngAll As Range: Set rngAll = [b3:j6]                       '= 해당영역 설정
    Dim RegV: RegV = Array("[a-zA-z]", "[\d+]", "[ㄱ-힇]")          '=  정규식 패턴 배열화
    Dim rngA As Range
    Dim rngX As Range
    Dim V
    Dim n&, cnt&, R&
    
    rngAll.Interior.ColorIndex = xlNone                             '= 초기화
    For Each rngA In rngAll.Rows                                    '= 전체영역을 행단위로 반복

        Do Until n > 2                                              '= 정규식 배열을 최대 0~2번까지 순환
            For Each rngX In rngA.SpecialCells(2)                   '= 행단위를 다시 셀에 값이 있는곳까지로 한정
  
                With Reg
        
                    .Pattern = RegV(n)                              '= 정규식 패턴을 하나씩 순환 적용
                    .Global = True
        
                End With
              
                 If Reg.test(rngX) Then                             '= 정규식 패턴과 일치하면
                    
                    cnt = cnt + 1                                   '= Cnt를 +1 해라
                    
                    V = Array(rngX.Row, rngX.Column)                '= 배열에 해당 셀의 위치를 형 / 열로 담아라
                    If cnt > 1 Then V = Empty                       '= cnt 가 1보다 많을 때 / 즉 유일값이 아니면
                                                                    '= 배열을 비워라
                 End If
                
            Next rngX
            
    
            If cnt = 1 Then Exit Do                                 '= 유일값이면 Do 탈출
            
            cnt = 0: n = n + 1                                      '= 유일값이 아니면 Cnt는 0 / 패턴순환상수
                                                                    '= n은 +1
        
        Loop                                                        '= n값이 2가 될때까지 순환
      
            If IsEmpty(V) Then V = Haja(rngA, Reg, RegV)            '= 정규 패턴을 모두 순환해도 배열이 비어있으면 Haja함수 호출
            
            Cells(V(0), V(1)).Interior.ColorIndex = 6
           
        
            Erase V
            n = 0: cnt = 0

    Next rngA

End Sub

Function Haja(rngA As Range, Reg As Object, RegV As Variant) As Variant

    Dim rngX As Range
    Dim cnt&
    Dim V, n&
    
    Do Until n > 2
        With Reg
            
            .Pattern = RegV(n)
            .Global = True
    
        End With
        
        For Each rngX In rngA.SpecialCells(2)
           
            If Reg.test(rngX) = False Then
                
               cnt = cnt + 1
               V = Array(rngX.Row, rngX.Column)
                
            End If
        
        Next rngX
        n = n + 1
        
        If cnt = 1 Then Haja = V: Exit Function
        cnt = 0
    
    Loop

End Function

특이점 찾아내기.xlsm

0.02MB