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