Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Validação de Dados
 
Notifications
Clear all

Validação de Dados

 
2024 - VBA & Macros
8 Posts
2 Usuários
0 Reactions
1,139 Visualizações
RSS
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Pessoal,
Uso a Worksheet_Change abaixo e agora, no mesmo Intervalo, preciso impedir a Digitação de Valores Repetidos nas
Células das Linhas (B5:P5, B6:P6........ até B14:P14).
Ao encontrar Valor Repetido, avisar com Mensagem de Erro.
Preciso do código pelo Vba.
Grato,
Pedro

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Range("B5:P5")) Is Nothing Then
    If Target.Value < 1 Then 'de 01 a 99.
        MsgBox "Somente Valores de 01 a 99"
        Target.Offset(0, 0).Select
        Target = ""
  
    End If
    If Target.Value > 99 Then
        MsgBox "Somente Valores de 01 a 99"
        Target.Offset(0, 0).Select
        Target = ""
    End If
End If


If Not Range("A15") Is Nothing Then
If Range("a15") = "PARABÉNS!" Then
'Alarme1
End If
If Range("a15") = "" Then
Sheets("Dados").Label2.Visible = False
Else
Sheets("Dados").Label2.Visible = True
End If

End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Postado : 09/06/2016 9:50 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde!!

Consegue adaptar?

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target.EntireColumn
    If .Cells.Count = 1 And Not (Application.Intersect(Target, .Range("Meu Intervalo")) Is Nothing) Then
   
        If 1 < Application.CountIf(.Range("Meu Intervalo"), .Value) Then
            Application.EnableEvents = False
            .ClearContents
            MsgBox "valores repetidos"
            Application.EnableEvents = True
        End If
    End If
  End With
End Sub

Att

 
Postado : 09/06/2016 9:54 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Alexandre,
Obrigado pela atenção.

Não funcionou.
Fiz o teste, também, em uma nova planilha.
Agradeço se puder rever a função.

Pedro

 
Postado : 09/06/2016 5:42 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bom dia!!!

Ok , tente assim

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Or IsEmpty(Target(1, 1)) Then Exit Sub
     
    If Not Intersect(Target, Range("B5:P6", "B14:P14")) Is Nothing Then
        If WorksheetFunction.CountIf(Range("B5:P6", "B14:P14"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
    End If
End Sub

Att

 
Postado : 10/06/2016 5:57 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Valeu, Alexandre!
Obrigado!

Como o meu Intervalo é ("B5:P14") e preciso da Validação Por Linhas: ("B5:P5") até ("B14:P14") ,
adaptei a função.
Obs: Ficou feio e pesado, mas funcionou.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or IsEmpty(Target(1, 1)) Then Exit Sub
     
    If Not Intersect(Target, Range("B5:P14")) Is Nothing Then
        If WorksheetFunction.CountIf(Range("B5:P5"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B6:P6"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B7:P7"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B8:P8"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B9:P9"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B10:P10"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B11:P11"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B12:P12"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B13:P13"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
        If WorksheetFunction.CountIf(Range("B14:P14"), Target) > 1 Then
            MsgBox Target & " Já existe"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
End Sub
 
Postado : 10/06/2016 10:02 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde!!

Você pode usar uma subrotina e depois chama-lo dentro do evento 

Private Sub Worksheet_Change(ByVal Target As Range)

Além disso, vc pode usar formulas via VBA para checar os dados duplicados (depois transforma-los em valores para não ficar pesado).

Caso insistir em sua esse evento da forma como expôs, tente deixar o processos mais rápidos, veja em:
http://www.cpearson.com/excel/optimize.htm

Att

 
Postado : 10/06/2016 10:35 am
 Osvaldomp
(@osvaldomp)
Posts: 857
Prominent Member
 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Or IsEmpty(Target(1, 1)) Then Exit Sub
 If Intersect(Target, Range("B5:P14")) Is Nothing Then Exit Sub
  If WorksheetFunction.CountIf(Range(Cells(Target.Row, 2), Cells(Target.Row, 16)), Target.Value) > 1 Then
   MsgBox Target.Value & " Já existe"
   Application.EnableEvents = False
   Application.Undo
   Application.EnableEvents = True
  End If
End Sub
 
Postado : 10/06/2016 10:52 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Osvaldomp e Alexandre,
Obrigado pela atenção.
As duas sugestões funcionam perfeitamente.
Obrigado,
Pedro

 
Postado : 10/06/2016 4:54 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico