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!
|
1 |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
'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 |
|
1 |
|
1 |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
'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 |
|
1 |