No duplicar un dato en una hoja excel (ampliación)

Una/s consulta/s en relación a este tema, respondido por Luis Mondelo.

Al código que sigue (enviado por Luis Mondelo)

Private Sub Worksheet_Change(ByVal Target As Range)

valor = Target.Value

contarsi = Application.WorksheetFunction.CountIf(Columns(5), valor)

If contarsi > 1 Then

MsgBox "el dato está duplicado y no se admite"

Target.Select

Target.ClearContents

End If
End Sub

necesito hacerle unas modificaciones, a saber:

1) Necesito que "monitoree" varias filas en una hoja, y "evite" duplicados en ellas, pero que no tome en cuenta los valores menores a 10.

Necesito monitorear:
Fila 6 (más exactamente, el rango $B$6:$BO$6)
Fila 20 (más exactamente, el rango $B$20:$BO$20)
Fila 34 (más exactamente, el rango $B$34:$BO$34)
Fila 48 (más exactamente, el rango $B$48:$BO$48)
Fila 62 (más exactamente, el rango $B$62:$BO$62)
Fila 76 (más exactamente, el rango $B$76:$BO$76)

1 respuesta

Respuesta
1

Se puede modificar la macro de esta manera:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangoC(7) As String
valor = Target.Value
RangoC(1) = "$B$6:$BO$6"
RangoC(2) = "$B$20:$BO$20"
RangoC(3) = "$B$34:$BO$34"
RangoC(4) = "$B$48:$BO$48"
RangoC(5) = "$B$62:$BO$62"
RangoC(6) = "$B$76:$BO$76"
For X = 1 To 6
contarsi = Application.WorksheetFunction.CountIf(Range(RangoC(X)), valor)
If contarsi > 1 Then
    MsgBox "el dato está duplicado y no se admite"
    Target.Select
    Target.ClearContents
    X = 6
End If
Next X
End Sub

Perdón, me ha faltado lo de no tener en cuenta valore menores de 10, entonces añadir dos líneas más a esta parte:

If contarsi > 1 Then
    If valor > 9 Then
    MsgBox "el dato está duplicado y no se admite"
    Target.Select
    Target.ClearContents
    X = 6
    End If
End If

Excelente, Miguel!
Funciona perfectamente.
Abusando de tu amabilidad, pregunto:
¿Y si yo quisiera que XL "no me permita" escribir duplicados, aunque el valor ya se encuentre en CUALQUIER FILA (y no necesariamente en la misma fila?
Espero haberme hecho entender...
Gracias nuevamente!

Aquí he cambiado la macro para eso:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangoC(7) As String
valor = Target.Value
If valor < 9 Then Exit Sub
RangoC(1) = "$B$6:$BO$6"
RangoC(2) = "$B$20:$BO$20"
RangoC(3) = "$B$34:$BO$34"
RangoC(4) = "$B$48:$BO$48"
RangoC(5) = "$B$62:$BO$62"
RangoC(6) = "$B$76:$BO$76"
For X = 1 To 6
contarsi = Application.WorksheetFunction.CountIf(Range(RangoC(X)), valor)
If Range(RangoC(X)).Row = Target.Row Then cuentamin = 1 Else cuentamin = 0
If contarsi > cuentamin Then
    MsgBox "el dato está duplicado y no se admite"
    Target.Select
    Target.ClearContents
End If
Next X
End Sub

Mejor cambia 9 por 10 aquí:

If valor < 10 Then Exit Sub

Gracias por responder nuevamente, Miguel.

Algo debo estar haciendo mal, porque, la macro funciona; pero es como que "monitoriza" TODA la hoja, y no sólo las FILAS en cuestión.

Ejemplo 1:
Me posiciono en cualquier celda (de las Fila que NO debería monitorear)...
Aparece el MsgBox --> Le doy Enter --> (esto se repite 7 veces por celda, luego no aparece más el MsgBox)
(dato: todas estas celdas contienen fórmulas)


Tal vez, expresé mal mi solicitud de ampliación y, donde dije "aunque el valor ya se encuentre en CUALQUIER FILA"; debí decir "aunque el valor ya se encuentre en CUALQUIER FILA DE LAS MENCIONADAS (FILAS 6 ; 20 ; 34 ; 48 ; 62 ; 76).


Ejemplo 2:
Me posiciono en cualquier celda (de las Fila que SÍ debería monitorear)...
Y funciona perfectamente!


Ojalá puedas ayudarme nuevamente, lo que agradeceré infinitamente.

Sí la verdad es que la macro da mensaje siempre que al menos un valor esté ya en los rangos y el segundo puede estar dentro o fuera. Si el valor se duplica totalmente fuera de los rangos no da mensaje.

Prueba a ver esta variación:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangoC(77) As String
valor = ActiveCell.Value
If valor < 10 Then Exit Sub
RangoC(6) = "$B$6:$BO$6"
RangoC(20) = "$B$20:$BO$20"
RangoC(34) = "$B$34:$BO$34"
RangoC(48) = "$B$48:$BO$48"
RangoC(62) = "$B$62:$BO$62"
RangoC(76) = "$B$76:$BO$76"
For X = 6 To 76 Step 14
If Target.Row = X Then GoTo CONTINUAR
Next X
Exit Sub
CONTINUAR:
For X = 6 To 76 Step 14
contarsi = Application.WorksheetFunction.CountIf(Range(RangoC(X)), valor)
If Range(RangoC(X)).Row = Target.Row Then cuentamin = 1 Else cuentamin = 0
If contarsi > cuentamin Then
    MsgBox "el dato está duplicado y no se admite"
    Target.Select
    Target.ClearContents
End If
Next X

P.f., añade End sub al final, que parece que no se copió .

Miguel, lo tuyo, simplemente EX CE LEN TE !!!
(si encuentro cómo hacerlo, me gustaría enviarte un mail)
¡Millones de Gracias!
Con esto doy por finalizado el tema.

Pues me alegro que te haya servido. Mi dirección de email es citofacta(at)interbook.net, (at) equivale a arroba.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas