MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Função InStr suportando expressões regulares

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2307
    Registrado : 22/11/2016

    Função InStr suportando expressões regulares Empty Função InStr suportando expressões regulares

    Mensagem  DamascenoJr. em 14/10/2020, 06:16

    Depois de ler este artigo
    usandoaccess.com.br/tutoriais/expressoes-regulares-microsoft-access.asp?id=1

    E ler este divertido livro online
    aurelio.net/regex/guia/

    Resolvi dar um "upgrade" na função InStr.

    Veja
    Código:
    Public Function fncInStr(ByVal strTexto As String, _
                            ByVal strExpressao As String, _
                            Optional ByVal booUsaExpressaoRegular As Boolean = False, _
                            Optional ByVal booReverso As Boolean = False, _
                            Optional ByVal booCaseSensitive As Boolean = True, _
                            Optional ByVal intPosOndeComeca As Integer = 0) _
                            As Integer
    ' ----------------------------------------------------------------
    ' Autor    : DamascenoJr. (contato@damascenojr.com.br)
    ' Data      : 13/10/2020
    ' Propósito : Retornar a posição de um trecho de texto que atenda a uma expressão.
    ' ----------------------------------------------------------------

        If Not booUsaExpressaoRegular Then
            If booReverso Then
                fncInStr = InStrRev(strTexto, strExpressao, IIf(intPosOndeComeca = 0, -1, intPosOndeComeca), IIf(booCaseSensitive, vbBinaryCompare, vbTextCompare))
            Else
                fncInStr = InStr(IIf(intPosOndeComeca = 0, 1, intPosOndeComeca), strTexto, strExpressao, IIf(booCaseSensitive, vbBinaryCompare, vbTextCompare))
            End If
            Exit Function
        End If
       
        Const LETRAS_MAIUSCULAS_COM_ACENTO As String = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊÇÑ"
        Const LETRAS_MINUSCULAS_COM_ACENTO As String = "áíóúéäïöüëàìòùèãõâîôûêçñ"

        Dim objRegEx            As Object
        Dim objMatchCollection  As Object
       
        strExpressao = Replace(strExpressao, "[:upper:]", "A-Z" & LETRAS_MAIUSCULAS_COM_ACENTO)
        strExpressao = Replace(strExpressao, "[:lower:]", "a-z" & LETRAS_MINUSCULAS_COM_ACENTO)
        strExpressao = Replace(strExpressao, "[:alpha:]", "A-Za-z" & LETRAS_MAIUSCULAS_COM_ACENTO & LETRAS_MINUSCULAS_COM_ACENTO)
        strExpressao = Replace(strExpressao, "[:alnum:]", "A-Za-z0-9" & LETRAS_MAIUSCULAS_COM_ACENTO & LETRAS_MINUSCULAS_COM_ACENTO)
        strExpressao = Replace(strExpressao, "[:digit:]", "0-9")
        strExpressao = Replace(strExpressao, "[:xdigit:]", "A-Fa-f0-9")
        strExpressao = Replace(strExpressao, "[:punct:]", ".,!?:...")
        strExpressao = Replace(strExpressao, "[:blank:]", " \t")
        strExpressao = Replace(strExpressao, "[:space:]", " \t\n\r\f\v")
        strExpressao = Replace(strExpressao, "[:graph:]", "^ \t\n\r\f\v")
        strExpressao = Replace(strExpressao, "[:print:]", "^\t\n\r\f\v")

        Set objRegEx = CreateObject("VbScript.RegExp")
       
        With objRegEx
       
            .Global = True
            .IgnoreCase = Not booCaseSensitive
            .Pattern = strExpressao
           
            If booReverso And (intPosOndeComeca > 0) Then
                strTexto = Left(strTexto, intPosOndeComeca)
            Else
                If intPosOndeComeca = 0 Then intPosOndeComeca = 1
                strTexto = Mid(strTexto, intPosOndeComeca)
            End If
           
            Set objMatchCollection = .Execute(strTexto)
            With objMatchCollection
                If .Count > 0 Then
                    If booReverso Then
                        fncInStr = InStrRev(strTexto, .Item(.Count - 1), -1, IIf(booCaseSensitive, vbBinaryCompare, vbTextCompare))
                    Else
                        fncInStr = InStr(1, strTexto, .Item(0), IIf(booCaseSensitive, vbBinaryCompare, vbTextCompare))
                    End If
                End If
            End With
            Set objMatchCollection = Nothing
           
        End With
       
        Set objRegEx = Nothing
       
    End Function


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

    Avelino Sampaio e Marcelo David gostam desta mensagem

    Marcelo David
    Marcelo David
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3189
    Registrado : 21/04/2011

    Função InStr suportando expressões regulares Empty Re: Função InStr suportando expressões regulares

    Mensagem  Marcelo David em 15/10/2020, 13:38

    Rapaz, cada vez melhores seus exemplos! Parabéns e grato por compartilhar!


    .................................................................................
    Marcelo David
    https://www.freetool.dev (em construção)
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2307
    Registrado : 22/11/2016

    Função InStr suportando expressões regulares Empty Re: Função InStr suportando expressões regulares

    Mensagem  DamascenoJr. em 15/10/2020, 23:50

    Obrigado, Marcelo. Surprised


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

      Data/hora atual: 25/10/2020, 00:47