Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
VERIFICAÇÃO DE DADO...
 
Notifications
Clear all

VERIFICAÇÃO DE DADOS

 
2024 - VBA & Macros
Post Recente por EdsonBR 6 anos atrás
2 Posts
2 Usuários
0 Reactions
895 Visualizações
RSS
 RenanFelix
(@renanfelix)
Posts: 0
New Member
Topic starter
 

Boa noite, Caros.

Precisava de uma Function em VBA que compare o valor de uma célula e verifique se está correto, ou seja seguindo o padrão, um membro do site em um tópico anterior me deu uma ajuda, mas precisava incluir mais dados, porém realizei uma alteração e o código sempre da como FALSO. Em anexo tem uma planilha explicando tudo e com exemplo, no caso pegar a forma de nomear: TEXTO_TEXTO1_NOME_12345678910_TEXTO2_03072018_2135_12345678910_NA_ATIVO_PF_ESCOB_MOVEL_MASSIVO_NA_IGUAL30_MENOR2000_001 e depois verificar se ela segue o padrão no caso de PF (TEXTO_TEXTO1_NOME_11digitos_TEXTO2_DDMMAAAA_HHMM_11digitos_NA_DADOS1_PF_DADOS2_DADOS3_MASSIVO_NA_DADOS4_DADOS5_001) depois mostrar se está errado ou correto.

Abaixo código modificado:

Function CódigoÉVálido(cód As String) As Boolean
  With CreateObject("VBScript.RegExp") ' rgx
   .Pattern = "^(TEXTO)_(TEXTO1)_(NOME)_(d{11})_(TEXTO2)_(d{2})(d{2})(d{4})_(d{2})_((d{11}_NA_(ATIVO|RECEPTIVO)_PF)|(d{14}_NA_(ATIVO|RECEPTIVO)_PJ))_(ESCOB|TELE)_(MOVEL|FIXA|TV)_(MASSIVO)_(NA)_(NA|MENOR30|(IGUAL|MAIOR)[36]0)_(NA|MENOR2000|MAIOR2000)_(001)$"
    If .Test(cód) Then
    With .Execute(cód)(0).SubMatches
      CódigoÉVálido = IsDate(.Item(6) & "/" & .Item(7) & "/" & .Item(8))
    End With
   End If
   End With
End Function

'==========================================
    'Autor Original: Edson BR
    Adaptação:
    '==========================================

Código Original:

Function CódigoÉVálido(cód As String) As Boolean
  With CreateObject("VBScript.RegExp") ' rgx
   .Pattern = "^((d{11}_PF)|(d{14}_PJ))_(d{2})(d{2})(d{4})_(NA|MENOR30|(IGUAL|MAIOR)[36]0)$"
   If .Test(cód) Then
    With .Execute(cód)(0).SubMatches
      CódigoÉVálido = IsDate(.Item(3) & "/" & .Item(4) & "/" & .Item(5))
    End With
   End If
  End With
End Function
 
Postado : 05/07/2018 9:54 pm
 EdsonBR
(@edsonbr)
Posts: 0
New Member
 

Bom dia, Renan

Alterado:

Function CódigoÉVálido(cód As String) As Boolean
  Dim DtHr As Variant
  With CreateObject("VBScript.RegExp")
   .Pattern = "^.*_.*_.*_d{11}_.*_(d{2})(d{2})(d{4})_(d{2})(d{2})_((d{11}_NA_(ATIVO|RECEPTIVO)_PF)" & _
              "|(d{14}_NA_(ATIVO|RECEPTIVO)_PJ))_(ESCOB|TELE)_(MOVEL|FIXA|TV)_MASSIVO_NA_" & _
              "(NA|MENOR30|(IGUAL|MAIOR)[36]0)_(NA|MENOR2000|MAIOR2000)_001$"
   If .Test(cód) Then
    With .Execute(cód)(0).SubMatches
     DtHr = .Item(0) & "/" & .Item(1) & "/" & .Item(2) & " " & .Item(3) & ":" & .Item(4)
     CódigoÉVálido = IsDate(DtHr)
    End With
   End If
  End With
End Function

Obs.: Se em seus dados houver a possibilidade de combinação maiúsculas/minúsculas, insira na linha logo abaixo da criação do objeto RegExp a seguinte instrução:

With CreateObject("VBScript.RegExp")
.IgnoreCase = True

 
Postado : 06/07/2018 7:03 am
Forum Jump:
  Tópico Anterior
Próximo Tópico