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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
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
Osvaldo
Osvaldomp e Alexandre,
Obrigado pela atenção.
As duas sugestões funcionam perfeitamente.
Obrigado,
Pedro
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel