Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

macro filtro relleno

10/09/2008 - 21:24 por mariog | Informe spam
Ayuda Hacer una pregunta
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
email Siga el debateRespuesta 3 respuestasRespuesta Tengo una respuesta
DRAGON AGE™: INQUISITION – Matadragones
 

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

Preguntas similares

 

Busqueda sugerida :