A vueltas con los filtros avanzados

18/07/2006 - 00:44 por klomkbock | Informe spam
Hola a todos. Espero que los que esteis por otras latitudes no os esteis
derritiendo como los que andamos por estas, las hispanicas.

Aqui vuelvo de nuevo a abusar de vuestra generosidad.

Llevaba tiempo dandole vueltas a los filtros avanzados para rellenar un
combobox con los registros unicos de un campo variable(puede variar la
longitud del campo y el campo mismo). Al fin lo he conseguido.

El problema es que el motivo de usar los filtros era ganarle en velocidad
al proceso, que hasta ahora realizaba mediante un objeto collection,
cuando se trata de trabajar con varios miles de registros.

Por lo que se(de muy buena fuente en estas lides), el uso de filtros hace
mas rapida la ejecucion que el de colecciones, sin embargo, algo debo de
estar haciendo mal, pues de momento, y tras probar unas cuantas
posibilidades, el uso del objeto collection es bastante mas rapido que los
filtros.

Para 5000 registros, con filtro avanzado tarda entre 6 y 10 segundos,
mientras que con collection tarda un maximo de 2 segundos(si estos tiempos
fueran asi para hasta 20000 registros me podrian valer, pero me seguiria
quedando la espina de los filtros avanzados y de en que estoy fallando)

Al final expongo los codigos en ambos casos. Con los filtros expongo 3,
que tardan practicamente igual, pero antes explico su entorno brevemente??:

En los codigos intervienen:

=>a) tres hojas(en unos intervienen dos y tres en otros):

.-Hoja1= "Listado": contiene la lista con los datos. Para las pruebas
actuales 5000 registros. El unico campo que no puede tener registros
repetidos es el 1º(columna A) y, a partir del 5º(columna E), puede
contener registros vacios.
.-Hoja2= "Matrices": contiene listas para rellenar matrices o variables.
La que interviene en los codigos es la columna A que contiene un listado
con todas las letras de la A a la Z, que se corresponden con las columnas
de Listado (26 en total)
.-Hoja3= "Oculta": se usa para pegar los datos filtrados y pasarlos al
combo de destino.

=>b) dos combobox (que interesen al caso) de un formulario:

.-ComboBox1= "cmbElegir": contiene los titulos de los 26 campos de
"Listado" (rango "a1:z1"). Se cargan al inicializarse el formulario.
.-ComboBox2= "cmbCriterio": se rellena con los registros no repetidos del
campo elegido en "cmbElegir"(cmbElegir_Change).

==>> Este es el codigo con collection:

Private Sub cmbElegir_Change()
Dim rngListado As Range, xList As Long
Dim ListaUnicos As New Collection
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
For Each rngListado In .Range(ltC & "2:" & ltC & fF)
On Error Resume Next
If Trim(rngListado) <> "" Then _
ListaUnicos.Add rngListado, CStr(rngListado)
On Error GoTo 0
Next
End With
For xList = 1 To ListaUnicos.Count
cmbCriterio.AddItem ListaUnicos(xList)
Next
Set ListaUnicos = Nothing
Application.ScreenUpdating = True
End Sub

==>> y estos con advanced filter

->1ªprueba

Private Sub cmbElegir_Change()
''Se filtra bien, pero mas bien lento _
'''(de 7 a 10 sg con 5000 filas)
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
.Range(ltC & "1:" & ltC & fF).AdvancedFilter _
criteriarange:=.Range(ltC & "1:" & ltC & fF), _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
cmbCriterio.List = .Range("a2:a" & fFo).Value
End With
Application.ScreenUpdating = True
End Sub

->2ªprueba (quizas ligeramente mas rapido que el anterior pero no estoy seguro

Private Sub cmbElegir_Change()
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Cells(1, nL), _
header:=xlYes
.Range(.Cells(1, nL), .Cells(fF, nL)).AdvancedFilter _
criteriarange:=.Range(.Cells(1, nL), .Cells(fF, nL)), _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
cmbCriterio.List = .Range("a2:a" & fFo).Value
End With
Application.ScreenUpdating = True
End Sub

->3ªprueba (como la 1ª pero usando algunas variables mas, tarda igual)

Private Sub cmbElegir_Change()
''Prueba con variables range y variant para ver si agiliza
'''pero sigue mas o menos igual
Dim rngListado As Range, rngFiltrado
Application.ScreenUpdating = False
With cmbElegir
' If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
Set rngListado = .Range(ltC & "1:" & ltC & fF)
rngListado.AdvancedFilter _
criteriarange:=rngListado, _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
rngFiltrado = .Range("a2:a" & fFo).Value
cmbCriterio.List = rngFiltrado
End With
Application.ScreenUpdating = True
End Sub

Bueno, como siempre me ha salido otro tomo.

Si podeis echarme una mano os lo agradezco.

En cualquier caso, un saludo y hasta pronto.
Ivan
 

Leer las respuestas

#1 Héctor Miguel
18/07/2006 - 08:56 | Informe spam
hola, Ivan !

... tiempo dandole vueltas a los filtros avanzados para rellenar un combobox con los registros unicos de un campo variable...
... el motivo de usar los filtros era ganarle en velocidad al proceso, que hasta ahora realizaba mediante un objeto collection...
... algo debo de estar haciendo mal, pues de momento, y tras probar unas cuantas posibilidades
... el uso del objeto collection es bastante mas rapido que los filtros.
... 5000 registros, con filtro avanzado tarda entre 6 y 10 segundos... con collection tarda un maximo de 2 segundos
... para hasta 20000 registros me podrian valer, pero me seguiria quedando la espina de los filtros avanzados y de en que estoy fallando [...]



1) el siguiente ejemplo, probado con ~ 30000 registros en las columnas 'A:Z' de una hoja 'Listado', de las cuales...
[segun la columna 'elegida' en un cmbElegir] pudieran 'devolver' entre 300 a 2000 registros 'unicos'...
se ha tardado [en llenar un cmbCriterio] algo asi como... 'un suspiro' :))

2) los 'supuetos' son...
a) la 'funcion' del listindex del cmbElegir es 'solo' para asignar la literal de la columna 'seleccionada' [tu variable ltC]
b) las columnas 'utiles' de la hoja 'Listado' son -exclusivamente- de la 'A' a la 'Z' [el resto... esta 'disponible'] -?- <= OJO
c) [de lo anterior]... se deja libre la columna 'AA' y se aprovecha la columna 'AB' para el rango de extraccion [filtros avanzados]
d) como -se supone que- el resultado de la extraccion NO dejara celdas 'vacias'... la ordenacion se hace sobre el resultado [mas rapido]

3) 'te toca'... hacer las 'prevenciones' necesarias para cuando no haya 'unicos' a devolver :))

corre algunas pruebas... compara la velocidad 'versus' los objetos 'Collection' y...
si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

en el modulo de codigo del formulario ==Private Sub cmbElegir_Change()
Dim ltC As String
Application.ScreenUpdating = False
If cmbElegir.ListIndex < 0 Then Exit Sub Else ltC = Chr(64 + cmbElegir.ListIndex + 1)
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
.[ab:ab].Clear
.Columns(ltC).AdvancedFilter xlFilterCopy, , .[ab1], True
.[ab2].Sort Key1:=.[ab2], Order1:=xlAscending, Header:=True
cmbCriterio.List = .Range(.[ab2], .[ab2].End(xlDown)).Value
End With
End Sub

__ los datos y codigos expuestos __
.-Hoja1= "Listado": contiene la lista con los datos. Para las pruebas actuales 5000 registros.
El unico campo que no puede tener registros repetidos es ... columna A) y, a partir de... columna E), puede contener registros vacios.
.-Hoja2= "Matrices": contiene listas para rellenar matrices o variables.
La que interviene en los codigos es la columna A que contiene un listado con todas las letras de la A a la Z
que se corresponden con las columnas de Listado (26 en total)
.-Hoja3= "Oculta": se usa para pegar los datos filtrados y pasarlos al combo de destino.
.-ComboBox1= "cmbElegir": contiene los titulos de los 26 campos de "Listado" (rango "a1:z1"). Se cargan al inicializarse el formulario.
.-ComboBox2= "cmbCriterio": se rellena con los registros no repetidos del campo elegido en "cmbElegir"(cmbElegir_Change).
==>> Este es el codigo con collection:
Private Sub cmbElegir_Change()
Dim rngListado As Range, xList As Long
Dim ListaUnicos As New Collection
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
For Each rngListado In .Range(ltC & "2:" & ltC & fF)
On Error Resume Next
If Trim(rngListado) <> "" Then _
ListaUnicos.Add rngListado, CStr(rngListado)
On Error GoTo 0
Next
End With
For xList = 1 To ListaUnicos.Count
cmbCriterio.AddItem ListaUnicos(xList)
Next
Set ListaUnicos = Nothing
Application.ScreenUpdating = True
End Sub

==>> y estos con advanced filter
->1 prueba
Private Sub cmbElegir_Change()
''Se filtra bien, pero mas bien lento _
'''(de 7 a 10 sg con 5000 filas)
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
.Range(ltC & "1:" & ltC & fF).AdvancedFilter _
criteriarange:=.Range(ltC & "1:" & ltC & fF), _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
cmbCriterio.List = .Range("a2:a" & fFo).Value
End With
Application.ScreenUpdating = True
End Sub

->2 prueba (quizas ligeramente mas rapido que el anterior pero no estoy seguro
Private Sub cmbElegir_Change()
Application.ScreenUpdating = False
With cmbElegir
If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Cells(1, nL), _
header:=xlYes
.Range(.Cells(1, nL), .Cells(fF, nL)).AdvancedFilter _
criteriarange:=.Range(.Cells(1, nL), .Cells(fF, nL)), _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
cmbCriterio.List = .Range("a2:a" & fFo).Value
End With
Application.ScreenUpdating = True
End Sub

->3 prueba (como la 1ª pero usando algunas variables mas, tarda igual)
Private Sub cmbElegir_Change()
''Prueba con variables range y variant para ver si agiliza
'''pero sigue mas o menos igual
Dim rngListado As Range, rngFiltrado
Application.ScreenUpdating = False
With cmbElegir
' If .Value = .BoundValue Then Exit Sub
cmbCriterio.Clear: lstSeleccionar.Clear
If .ListIndex < 0 Then Exit Sub Else nL = .ListIndex + 1
End With
ltC = Worksheets("Matrices").Cells(nL, 1)
With Worksheets("Oculta")
.UsedRange.EntireRow.Delete
With Worksheets("Listado")
If .AutoFilterMode Then .AutoFilterMode = False
fF = .[a65536].End(xlUp).Row
.Range("a1:z" & fF).Sort _
key1:=.Range(ltC & "1"), _
header:=xlYes
Set rngListado = .Range(ltC & "1:" & ltC & fF)
rngListado.AdvancedFilter _
criteriarange:=rngListado, _
Action:=xlFilterCopy, _
copytorange:=Worksheets("Oculta").Range("a1"), _
unique:=True
End With
fFo = .Range("a65536").End(xlUp).Row
If fFo < 2 Then Exit Sub
rngFiltrado = .Range("a2:a" & fFo).Value
cmbCriterio.List = rngFiltrado
End With
Application.ScreenUpdating = True
End Sub

Bueno, como siempre me ha salido otro tomo.
Si podeis echarme una mano os lo agradezco.
En cualquier caso, un saludo y hasta pronto.
Ivan

Preguntas similares