Criando Validador no Excel com ProcV (VLookup) VBA

Nessa postagem vou criar um validador utilizando o VBA e para isso vou utilizar um recurso nativo do Excel, o ProcV (VLookup). A sistemática é bastante simples. Duas planilhas uma contendo os dados e outra contendo as regras que quando estiver com “X” informa que o campo é obrigatório. O arquivo usa o recurso do ProcV (VLookup) e traz em uma variável o retorno da função que é tratada via código.

Em uma planilha antes da execução do código temos a imagem abaixo, veja que temos os dados procurados e nada preenchido nas colunas de regra.

Em outra planilha colocamos as regras, onde X quer dizer que o campo é obrigatório. Na imagem abaixo podemos visualizar como está preenchido, observe como exemplo a primeira linha 101010 com a Regra 1 igual a X, isso significa que esse campo é obrigatorio.

Executando a rotina como esta, o resultado será o quadro abaixo, deixando os campos obrigatórios e não preenchidos conforme imagem acima ficam destacados em amarelo.

Agora como exemplo a primeira linha teve a regra 1 preenchida, observe na imagem abaixo e veja o resultado, perceba que o campo preenchido não está colorido de amarelo, mas os demais obrigatórios e não preenchidos estão.

Agora vamos alterar a última linha da planilha de validação para 909091, com isso o ProcV (VLookup), não vai encontrar a informação e isso ira gerar um erro no código VBA, que está sendo tratado utilizando o On Error Goto ErrTrat essa instrução ira tratar o erro para não trave e ira retornar a planilha comentando e colorindo para destacar que esse dado procurado não foi encontrado.

Pessoal essa é a dica. Existem varias formas de se chegar ao mesmo resultado, eu utilizo muito esse modelo no VBA, já fiz validadores em algumas empresas e o que acho mais legal é que a manutenção das regras (inclusão, exclusão e alteração) pode ser feita diretamente na planilha sem alteração no código VBA. Essa demonstração é um modelo que pode ser facilmente modificado, inserindo mais regras, tratando vários retornos da função enfim muitas utilidades. Espero que seja de utilidade!

'Autor: Fabio Mitsueda
'Contato: mitsueda.fabio@gmail.com
'Data Criação: 10/01/2021
Option Explicit

Sub Validar()
    'Declarando variaveis de planilha e utilizadas em repetição
    Dim shtDados        As Worksheet
    Dim shtRegra        As Worksheet
    Dim x, y            As Integer
    'Declarando variaveis usadas no procv
    Dim rngArea         As Range
    Dim varCriterio     As Variant
    Dim retVlookup

    'Setando variavel que representam as planilhas
    Set shtDados = ThisWorkbook.Sheets("Principal")
    Set shtRegra = ThisWorkbook.Sheets("Regra")

    'Carregando variavel de objeto range com area definida para procv
    Set rngArea = shtRegra.Range("A:D")

    'Capturando a utlima linha preenchida da coluna A na planilha principal
    y = shtDados.Range("A1048576").End(xlUp).Row

    'Habilitar tratamento de erros
    On Error GoTo ErrTrat
    'Fazer laço de repetição For (looping), linha por linha
    For x = 2 To y
        'Carregando criterio para procv
        varCriterio = shtDados.Cells(x, 1).Value
        
        'Testando regra 1
        retVlookup = Application.WorksheetFunction.VLookup(varCriterio, rngArea, 2, False)
        'Trantando retorno
        If retVlookup = "X" Then
            If shtDados.Cells(x, 2).Value = "" Then
                shtDados.Cells(x, 2).Interior.Color = 65535
            End If
        End If
        
        'Testando regra 2
        retVlookup = Application.WorksheetFunction.VLookup(varCriterio, rngArea, 3, False)
        'Trantando retorno
        If retVlookup = "X" Then
            If shtDados.Cells(x, 3).Value = "" Then
                shtDados.Cells(x, 3).Interior.Color = 65535
            End If
        End If
        
Voltar:
    Next

    'Descarregando variaveis
    Set shtDados = Nothing
    Set shtRegra = Nothing

'Incluido ponto de saida antes do final da sub
Exit Sub

'Tratamento de erro
ErrTrat:
    With shtDados.Cells(x, 1)
        .Interior.Color = 65535
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:="Registro não encontrado!!!"
        .Comment.Shape.TextFrame.Characters.Font.Name = "Courier New"
        .Comment.Shape.TextFrame.Characters.Font.Size = 8
        .Comment.Shape.Placement = xlFreeFloating
        .Comment.Shape.TextFrame.AutoSize = True
    End With
    'Retornando ao final do laço de repetição
    Resume Voltar

End Sub

 

'Autor: Fabio Mitsueda
'Contato: mitsueda.fabio@gmail.com
'Data Criação: 10/01/2021
Option Explicit

Sub Validar()
    'Declarando variaveis de planilha e utilizadas em repetição
    Dim shtDados        As Worksheet
    Dim shtRegra        As Worksheet
    Dim x, y            As Integer
    'Declarando variaveis usadas no procv
    Dim rngArea         As Range
    Dim varCriterio     As Variant
    Dim retVlookup

    'Setando variavel que representam as planilhas
    Set shtDados = ThisWorkbook.Sheets("Principal")
    Set shtRegra = ThisWorkbook.Sheets("Regra")

    'Carregando variavel de objeto range com area definida para procv
    Set rngArea = shtRegra.Range("A:D")

    'Capturando a utlima linha preenchida da coluna A na planilha principal
    y = shtDados.Range("A1048576").End(xlUp).Row

    'Habilitar tratamento de erros
    On Error GoTo ErrTrat
    'Fazer laço de repetição For (looping), linha por linha
    For x = 2 To y
        'Carregando criterio para procv
        varCriterio = shtDados.Cells(x, 1).Value
        
        'Testando regra 1
        retVlookup = Application.WorksheetFunction.VLookup(varCriterio, rngArea, 2, False)
        'Trantando retorno
        If retVlookup = "X" Then
            If shtDados.Cells(x, 2).Value = "" Then
                shtDados.Cells(x, 2).Interior.Color = 65535
            End If
        End If
        
        'Testando regra 2
        retVlookup = Application.WorksheetFunction.VLookup(varCriterio, rngArea, 3, False)
        'Trantando retorno
        If retVlookup = "X" Then
            If shtDados.Cells(x, 3).Value = "" Then
                shtDados.Cells(x, 3).Interior.Color = 65535
            End If
        End If
        
Voltar:
    Next

    'Descarregando variaveis
    Set shtDados = Nothing
    Set shtRegra = Nothing

'Incluido ponto de saida antes do final da sub
Exit Sub

'Tratamento de erro
ErrTrat:
    With shtDados.Cells(x, 1)
        .Interior.Color = 65535
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:="Registro não encontrado!!!"
        .Comment.Shape.TextFrame.Characters.Font.Name = "Courier New"
        .Comment.Shape.TextFrame.Characters.Font.Size = 8
        .Comment.Shape.Placement = xlFreeFloating
        .Comment.Shape.TextFrame.AutoSize = True
    End With
    'Retornando ao final do laço de repetição
    Resume Voltar

End Sub

CLIQUE AQUI PARA BAIXAR O ARQUIVO DE EXEMPLO.