Impedir entradas duplicadas en un intervalo
En el ejemplo de código siguiente se comprueba que existe un valor especificado en el intervalo A1:B20 dentro de ese intervalo en cualquiera de las hojas de cálculo del libro actual e impide entradas duplicadas si el valor existe.
Código de ejemplo proporcionado por: Holy Macro! Books,Holy Macro! It's 2,500 Excel VBA Examples (Holy Macro! 2500 ejemplos de VBA para Excel).
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Define your variables.
Dim ws As Worksheet, EvalRange As Range
'Set the range where you want to prevent duplicate entries.
Set EvalRange = Range("A1:B20")
'If the cell where value was entered is not in the defined range, if the value pasted is larger than a single cell,
'or if no value was entered in the cell, then exit the macro.
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If the value entered already exists in the defined range on the current worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
MsgBox Target.Value & " already exists on this sheet."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
'Check the other worksheets in the workbook.
For Each ws In Worksheets
With ws
If .Name <> Target.Parent.Name Then
'If the value entered already exists in the defined range on the current worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:B20"), Target.Value) > 0 Then
MsgBox Target.Value & " already exists on the sheet named " & .Name & ".", _
16, "No duplicates allowed in " & EvalRange.Address(0, 0) & "."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit For
End If
End If
End With
Next ws
End Sub
Acerca del colaborador
Holy Macro! Books publica libros amenos para los usuarios de Microsoft Office. Vea el catálogo completo en MrExcel.com.
Soporte técnico y comentarios
¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.
Comentarios
https://aka.ms/ContentUserFeedback.
Próximamente: A lo largo de 2024 iremos eliminando gradualmente GitHub Issues como mecanismo de comentarios sobre el contenido y lo sustituiremos por un nuevo sistema de comentarios. Para más información, vea:Enviar y ver comentarios de