2014年10月2日木曜日

[Excel VBA] 正規表現パターンと一致する文字列(or 部分文字列)を取得、またはカウントするワークシート関数




※参照設定が必要
Microsoft VBScript Regular Expressions 5.5


Public Function Regex( _
        Source As String, _
        Pattern As String, _
        Optional Flags As String = "", _
        Optional MatchIndex As Long = 0, _
        Optional SubMatchIndex As Long = 0 _
    )

    Dim RetVal
    Dim Matches As VBScript_RegExp_55.MatchCollection
    Dim SubMatches As VBScript_RegExp_55.SubMatches

    If MatchIndex = 0 Then
        If SubMatchIndex = 0 Then
            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = True
                .Pattern = Pattern
                RetVal = .Execute(Source).Count
            End With
        Else
            RetVal = CVErr(XlCVError.xlErrValue)
        End If

    ElseIf MatchIndex > 0 Then
        If SubMatchIndex = 0 Then

            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = MatchIndex > 1
                .Pattern = Pattern
                Set Matches = .Execute(Source)
                If MatchIndex <= Matches.Count Then
                    RetVal = Matches(MatchIndex - 1).Value
                Else
                    RetVal = ""
                End If
            End With

        ElseIf SubMatchIndex > 0 Then

            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = MatchIndex > 1
                .Pattern = Pattern
                Set Matches = .Execute(Source)
                If MatchIndex <= Matches.Count Then
                    Set SubMatches = Matches(MatchIndex - 1).SubMatches
                    If SubMatchIndex <= SubMatches.Count Then
                        RetVal = CStr(SubMatches(SubMatchIndex - 1))
                    Else
                        RetVal = ""
                    End If
                Else
                    RetVal = ""
                End If
            End With

        Else
            RetVal = CVErr(XlCVError.xlErrValue)
        End If
    Else
        RetVal = CVErr(XlCVError.xlErrValue)
    End If

    Regex = RetVal

End Function
















0 件のコメント:

コメントを投稿