Al escribir en una celda una referencia, localizar en esa misma columna todas las referencias iguales
A lo mejor no se puede hacer
Necesitaría, que si escribo en la celda "D7", una referencia, me localice todas las líneas que contengan la misma referencia, en la columna "D", y me las ponga correlativas en el rango, las líneas completas, Range("A8:P8"), ocultando todas las demás líneas, para no cambiar la intentar.
Y que cuando borre, la celda"D7", vuelvan a mostrar todas las columnas ocultas a su intentar anterior.
1 Respuesta
Buenas tardes, ni yo mismo entendí lo que escribí de noche, esto es para especificarlo mejor
A lo mejor no se puede hacer
Necesitaría, que si escribo en la celda "D7", una referencia, me localice todas las líneas que contengan la misma referencia, en la columna "D", y me las ponga correlativas en la columna "D", con las líneas completas, Range("A8:P8"), ocultando todas las demás líneas, para no cambiar la intentar de las demás columnas.
Ya que los distintos datos están en las columnas anteriores y posteriores e n el rango, Range("A:P")
Y que cuando borre, la celda"D7", vuelvan a mostrar todas las columnas ocultas a su anterior intentar.
Un saludo
Lo preparo y te lo mando
H o l a:
Lo que se tiene que programar en la macro es un filtro avanzado, pero para que funcione el filtro avanzado, deberás poner un título único para cada columna, el título de la celda D9 lo tienes que repetir en la celda D6:
Pon lo siguiente en los eventos de tu hoja
If Not Intersect(Target, Range("D7")) Is Nothing Then
u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If [D7] = "" Then Exit Sub
Range("A9:P" & u).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("D6:D7"), Unique:=False
End IfEl evento completo con lo que ya tienes quedaría así:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("B10:E593")) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="1"
For Each c In Target
If Not Intersect(c, Range("D10:D593")) Is Nothing Then
If Range("B" & c.Row) = "" Then
Range("B" & c.Row) = Date - 1
Else
Range("B" & c.Row & ":E" & c.Row).Font.Bold = True
Range("B" & c.Row & ":E" & c.Row).Interior.ColorIndex = 3
Range("B" & c.Row & ":E" & c.Row).Font.ColorIndex = 2
End If
End If
c.Value = UCase(c.Value)
Next
Application.EnableEvents = True
End If
'
If Not Intersect(Target, Range("D7")) Is Nothing Then
u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If [D7] = "" Then Exit Sub
Range("A9:P" & u).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("D6:D7"), Unique:=False
End If
End SubCada que modifiques la celda D7 se realizará el filtro avanzado.
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
