macro filtro relleno

10/09/2008 - 21:24 por mariog | Informe spam
esta macro es para filtrar por relleno.. pero quisiera saber como ejecutarla
sin necesidad de estar sobre la celda.. es posible??.. o alguna indicacion
para que vaya a esa celda que quiero filtrar desde otro lado..
soy un novato en esto..
muchas gracias
Mario

Sub FiltroInterior()
Dim XColor As Double
Dim Activa As String
Dim CAc, FAc, C, F As Double
Dim j As Double

XColor = ActiveCell.Interior.ColorIndex
Activa = ActiveCell.Address
CAc = ActiveCell.Column
FAc = ActiveCell.Row

Application.ScreenUpdating = False
Selection.CurrentRegion.Select
For F = Selection.Row + 1 To Selection.Rows.Count
If Cells(F, CAc).Interior.ColorIndex <> XColor Then
Cells(F, CAc).RowHeight = 0
Else
'Remover para filtrar en forma acumulativa
Cells(F, CAc).RowHeight = 12.75
End If
Next F
Range(Activa).Select
Application.ScreenUpdating = True
End Sub

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
10/09/2008 - 23:22 | Informe spam
hola, mario !

esta macro es para filtrar por relleno.. pero quisiera saber como ejecutarla sin necesidad de estar sobre la celda.. es posible??..
o alguna indicacion para que vaya a esa celda que quiero filtrar desde otro lado..



el siguiente ejemplo no contempla mostrar filas previamente "filtradas"...

Sub Filtrar_X_Color()
Dim Muestra As Range, Color As Integer, Fila As Long
On Error Resume Next
Set Muestra = Application.InputBox( _
Prompt:="Selecciona la celda de muestra", _
Title:="Filtrar segun color en...", _
Default:=ActiveCell.Address, _
Type:=8)
If Muestra Is Nothing Then Exit Sub _
Else Color = Muestra.Cells(1).Interior.ColorIndex
Application.ScreenUpdating = False
With Muestra.CurrentRegion
For Fila = 2 To .Rows.Count
With .Cells(Fila, Muestra.Column - .Column + 1)
.EntireRow.Hidden = .Interior.ColorIndex <> Color
End With
Next
End With
Set Muestra = Nothing
End Sub

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ el codigo expuesto __
Sub FiltroInterior()
Dim XColor As Double
Dim Activa As String
Dim CAc, FAc, C, F As Double
Dim j As Double
XColor = ActiveCell.Interior.ColorIndex
Activa = ActiveCell.Address
CAc = ActiveCell.Column
FAc = ActiveCell.Row
Application.ScreenUpdating = False
Selection.CurrentRegion.Select
For F = Selection.Row + 1 To Selection.Rows.Count
If Cells(F, CAc).Interior.ColorIndex <> XColor Then
Cells(F, CAc).RowHeight = 0
Else
'Remover para filtrar en forma acumulativa
Cells(F, CAc).RowHeight = 12.75
End If
Next F
Range(Activa).Select
Application.ScreenUpdating = True
End Sub
Respuesta Responder a este mensaje
#2 mariog
11/09/2008 - 16:05 | Informe spam
perfecto! muchas gracias.. y para perfeccionarlo un poco más.. es posible que
yo seleccione el color de relleno q quiero filtrar desde otra columna? no se
si se entiende la pregunta.. espero que si..
saludos
Mario
"Héctor Miguel" wrote:

hola, mario !

> esta macro es para filtrar por relleno.. pero quisiera saber como ejecutarla sin necesidad de estar sobre la celda.. es posible??..
> o alguna indicacion para que vaya a esa celda que quiero filtrar desde otro lado..

el siguiente ejemplo no contempla mostrar filas previamente "filtradas"...

Sub Filtrar_X_Color()
Dim Muestra As Range, Color As Integer, Fila As Long
On Error Resume Next
Set Muestra = Application.InputBox( _
Prompt:="Selecciona la celda de muestra", _
Title:="Filtrar segun color en...", _
Default:=ActiveCell.Address, _
Type:=8)
If Muestra Is Nothing Then Exit Sub _
Else Color = Muestra.Cells(1).Interior.ColorIndex
Application.ScreenUpdating = False
With Muestra.CurrentRegion
For Fila = 2 To .Rows.Count
With .Cells(Fila, Muestra.Column - .Column + 1)
.EntireRow.Hidden = .Interior.ColorIndex <> Color
End With
Next
End With
Set Muestra = Nothing
End Sub

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ el codigo expuesto __
> Sub FiltroInterior()
> Dim XColor As Double
> Dim Activa As String
> Dim CAc, FAc, C, F As Double
> Dim j As Double
> XColor = ActiveCell.Interior.ColorIndex
> Activa = ActiveCell.Address
> CAc = ActiveCell.Column
> FAc = ActiveCell.Row
> Application.ScreenUpdating = False
> Selection.CurrentRegion.Select
> For F = Selection.Row + 1 To Selection.Rows.Count
> If Cells(F, CAc).Interior.ColorIndex <> XColor Then
> Cells(F, CAc).RowHeight = 0
> Else
> 'Remover para filtrar en forma acumulativa
> Cells(F, CAc).RowHeight = 12.75
> End If
> Next F
> Range(Activa).Select
> Application.ScreenUpdating = True
> End Sub



Respuesta Responder a este mensaje
#3 Héctor Miguel
11/09/2008 - 22:08 | Informe spam
hola, mario !

... es posible que yo seleccione el color de relleno q quiero filtrar desde otra columna?
no se si se entiende la pregunta.. espero que si..



(supongo que) solo necesitas agregar otra variable de tipo rango:
- una para seleccionar la muestra del color
- otra para seleccionar la columna a filtrar

Sub Filtrar_X_Color()
Dim Muestra As Range, Columna As Range, Color As Integer, Fila As Long
On Error Resume Next
Set Muestra = Application.InputBox( _
Prompt:="Selecciona la celda de muestra", _
Title:="Filtrar segun color en...", _
Default:=ActiveCell.Address, _
Type:=8)
If Muestra Is Nothing Then Exit Sub _
Else Color = Muestra.Cells(1).Interior.ColorIndex
Set Columna = Application.InputBox( _
Prompt:="Selecciona la columna a filtrar", _
Title:="Filtrar segun color en...", _
Default:=ActiveCell.Address, _
Type:=8)
If Columna Is Nothing Then Goto Salida
Application.ScreenUpdating = False
With Columna.CurrentRegion
For Fila = 2 To .Rows.Count
With .Cells(Fila, Columna.Column - .Column + 1)
.EntireRow.Hidden = .Interior.ColorIndex <> Color
End With
Next
End With
Set Columna = Nothing
Salida:
Set Muestra = Nothing
End Sub

saludos,
hector.
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida