MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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

3 participantes

    Função InStr suportando expressões regulares

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  DamascenoJr. 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 : Respeito às Regras 100%

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

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

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

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


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Clique aqui e conheça o treinamento.
    Função InStr suportando expressões regulares Marcel11
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  DamascenoJr. 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.
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7367
    Registrado : 15/03/2013

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

    Mensagem  ahteixeira 16/11/2021, 11:22

    Olá a todos,

    ParabénsDamasceno, excelente "upgrade".

    cheers

    DamascenoJr. gosta desta mensagem

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  DamascenoJr. 16/11/2021, 23:44

    Valeu, Alvaro Very Happy


    .................................................................................
    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: 8/12/2021, 07:19