Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Validação da célula...
 
Notifications
Clear all

Validação da célula/coluna via VBA

 
2024 - VBA & Macros
Post Recente por luizhcosta 8 anos atrás
7 Posts
3 Usuários
0 Reactions
1,973 Visualizações
RSS
 luizhcosta
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Boa noite,

Busquei na rede uma solução, mas os exemplos são pouco eficazes e também tive dificuldades em adaptá-los.

O que preciso é fazer uma validação via VBA, evitando assim o uso da funcionalidade nativa do excel.

Tenho uma planilha que receberá Valor decimal, valor inteiro, texto e data. Gostaria de configurar via VBA as colunas para evitar a digitação de valores não previstos,

Um colega aqui do fórum vai me cobrar uma planilha, mas é bem simples de entender.

Vamos imaginar uma coluna para cada tipo de formato. É claro que também podemos imaginar o intervalo de cada coluna.

Considerem o seguinte:

* Coluna A, range "A2:A3500", Data - Recebe somente datas. Caso não seja uma data, emitir mensagem.
* Coluna B, range "B2:B3500", Decimal- Recebe somente valor decimal. Caso não seja um valor decimal, emitir mensagem.
* Coluna C, range "C2:C3500", Inteiro - Recebe somente valor inteiro. Caso não seja um valor inteiro, emitir mensagem.

A proxima validação é semelhante a LISTA da validação do excel, mas com os textos definidos no código, exemplo "Casa" "Navio" "Carro", aceitar somente estes valores na célula, caso não seja os valores definidos, emitir mensagem.

* Coluna D, range "D2:D3500", Lista

Acho que enviar o arquivo seria desnecessário.

O código poderia estar em um evento CHANGE.

Obrigado.

 
Postado : 14/05/2016 6:01 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

.....

 
Postado : 14/05/2016 6:24 pm
 tsa.xlsx
(@tsa-xlsx)
Posts: 0
New Member
 

Experimente este código:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng     As Range
Dim C       As Long 'Coluna
Dim L       As Long 'Linha
Dim lista(1 To 3) As String

On Error GoTo Erro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With 'Application

Set rng = Target

C = rng.Column
L = rng.Row

lista(1) = "Casa"
lista(2) = "Navio"
lista(3) = "Carro"

If L >= 2 And L <= 3500 Then
    Select Case C
    
        Case Is = 1 'Data
            If Not IsDate(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é data. Verifique.")
            End If
    
        Case Is = 2 'Decimal
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é decimal. Verifique.")
            Else
                If Int(rng.Value) = rng.Value Then
                    Application.Undo
                    MsgBox ("A informação digitada não é decimal. Verifique.")
                End If
            End If
            
        Case Is = 3 'Inteiro
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é número inteiro. Verifique.")
            Else
                If Int(rng.Value) <> rng.Value Then
                    Application.Undo
                    MsgBox ("A informação digitada não é número inteiro. Verifique.")
                End If
            End If
            
        Case Is = 4 'Lista
            If IsError(Application.Match(rng.Value, lista, False)) Then
                Application.Undo
                MsgBox ("A informação digitada não esta na lista. Verifique.")
            End If

    End Select
End If

Erro:

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With 'Application

End Sub
 
Postado : 14/05/2016 8:53 pm
 luizhcosta
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Tsa

Bom dia.

Rapaz o código ficou excelente, exatamente da forma imaginada. A parte do "Valor Decimal" é que não está aceitando inserir um valor que não tenha uma parte decimal. Talvez eu tenha me expressado mal. A idéia é receber valores, do tipo 1 e como a célula está formatada com 2 casas decimais, ficar 1,00, ou digitar 45 e ficar 45,00, ou ainda quando digitar 1458,78 ficar 1.458,78.

O restante do código está perfeito. Muito obrigado.

 
Postado : 15/05/2016 5:39 am
 luizhcosta
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Oi Tsa,

tentei modificar a linha ..."If Not IsNumeric(rng.Value)..." por "...If Not IsCurrency(rng.Value)", em partes funciona, mas aí também aceita letras e não é isso que desejo.

Apenas mais um detalhe. Fiquei impressionado com o código que só agora fui fazer os testes. Além do case 2 não aceitar valores monetários, a validação da data também apresenta um comportamento estranho. Como é uma validação, tem que validar antes e depois. O que ocorre é que, quando a célula está em branco, sem valor e se digita qualquer coisa que não seja data, aparece a crítiva. Quando se digita a data ela aceita. Mas se digitar qualquer caracter sobre a data, também aceita. Ou seja, a validação só acontece se a célula estiver em branco, depois não.

Pode ver ?

Obrigado.

 
Postado : 15/05/2016 7:28 am
 tsa.xlsx
(@tsa-xlsx)
Posts: 0
New Member
 

A parte do decimal poderia ser simplesmente assim (aceitando apenas números):

        Case Is = 2 'Decimal
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é decimal. Verifique.")
            End If

Ou assim, especificando que só pode ter 2 casas decimais no máximo:

        Case Is = 2 'Decimal
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é decimal. Verifique.")
            Else
                If Len(rng.Value - Int(rng.Value)) > 4 Then
                    Application.Undo
                    MsgBox ("A informação digitada não é decimal. Verifique.")
                End If
            End If

O caso da data, foi uma falha minha. Ao inserir uma data pela primeira vez, o Excel formata a célula como data e qualquer valo rnumerico vira data.
Nesse caso, alterei para validar somente a partir de uma data específica:

        Case Is = 1 'Data
            If Not IsDate(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é data válida. Verifique.")
            Else
                If CDate(rng.Value) <= DateValue("12/31/2015") Then
                    Application.Undo
                    MsgBox ("A informação digitada não é data válida. Verifique.")
                End If
            End If

O código completo, com as alterações:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng     As Range
Dim C       As Long 'Coluna
Dim L       As Long 'Linha
Dim lista(1 To 3) As String

On Error GoTo Erro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With 'Application

Set rng = Target

C = rng.Column
L = rng.Row

lista(1) = "Casa"
lista(2) = "Navio"
lista(3) = "Carro"

If L >= 2 And L <= 3500 Then
    Select Case C
    
        Case Is = 1 'Data
            If Not IsDate(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é data válida. Verifique.")
            Else
                If CDate(rng.Value) <= DateValue("12/31/2015") Then
                    Application.Undo
                    MsgBox ("A informação digitada não é data válida. Verifique.")
                End If
            End If
    
        Case Is = 2 'Decimal
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é decimal. Verifique.")
            Else
                If Len(rng.Value - Int(rng.Value)) > 4 Then
                    Application.Undo
                    MsgBox ("A informação digitada não é decimal. Verifique.")
                End If
            End If
            
        Case Is = 3 'Inteiro
            If Not IsNumeric(rng.Value) Then
                Application.Undo
                MsgBox ("A informação digitada não é número inteiro. Verifique.")
            Else
                If Int(rng.Value) <> rng.Value Then
                    Application.Undo
                    MsgBox ("A informação digitada não é número inteiro. Verifique.")
                End If
            End If
            
        Case Is = 4 'Lista
            If IsError(Application.Match(rng.Value, lista, False)) Then
                Application.Undo
                MsgBox ("A informação digitada não esta na lista. Verifique.")
            End If

    End Select
End If

Erro:

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With 'Application

End Sub
 
Postado : 16/05/2016 12:40 am
 luizhcosta
(@luizhcosta)
Posts: 0
New Member
Topic starter
 

Perfeito!

Mais uma vez obrigado.

 
Postado : 16/05/2016 10:00 am
Forum Jump:
  Tópico Anterior
Próximo Tópico