Últimos mensajes - Powered by IBM

Palabras claves

descargar mas rapido seleccion multiple en listbox

13/12/2006 - 01:37 por Ivan | Informe spam

hola a todos

tengo un formulario con un listbox con 4 columnas y seleccion multiple,
que se carga con los registros de una hoja ("Oculta"), que a su vez se
carga con los de otra ("Listado") filtrados por lo escrito en un
combo.

Un commandbutton (cmdActualizarFavoritos) permite cargar los registros
seleccionados (que no esten ya) en el listbox (lstSeleccionar) en otra
hoja ("Favoritos").

a su vez otro boton (cmdSeleccionarTodos) hace lo que su nombre indica,
seleccionar todos los registros del listbox, que, aunque serian muy
extraño, podrian llegar a ser hasta 10000. En realidad lo normal es
que sean bastantes menos, pues para algo esta el 'filtro'.

en mis pruebas el maximo que se carga tras escribir la primera letra en
el combo, ronda los 4500

Desde aqui el usuario tiene varias opciones, pero si selecciona todos
cuando la cantidad es muy alta y los añade a "Favoritos", viene a
tardar en torno a los 15 segundos (para 4400), tiempo que, aunque no es
excesivo para algo que sera muy raro que ocurra (una seleccion tan
amplia), y que incluso se puede avisar en estas ocasiones, si me
gustaria saber de que forma se podria disminuir.

he pensado en los filtros avanzados o en los autofiltros, pero no se
como los podria utilizar en esta ocasion, compatibilizando a la vez la
busqueda de elementos seleccionados en el listbox y de no repetidos en
"Favoritos"

de momento, y tras bastantes pruebas, me he decantado por esta opcion,
que es la que me ha dado el mejor tiempo, aunque tendre que unirla a
otra que es mucho mas rapida cuando los registros son pocos y que
supongo que tendre que condicionar al nº de registros seleccionados

Private Sub cmdActualizarFavoritos_Click()
Dim nSel As Long, CeldaO As Range, tCol As Long, tcol2 As Long
Dim tarda, x As Long
''pasa los libros seleccionados en lstSeleccionar a_
''la hoja "Favoritos"
tarda = Timer * 1000
With lstSeleccionar
tCol = .TextColumn: .TextColumn = 1
Application.ScreenUpdating = False
For nSel = 0 To .ListCount - 1
If .Selected(nSel) = True Then
On Error Resume Next
If BuscaFilas(CLng(.List(nSel)), "Favoritos") > 0 Then
Worksheets("Oculta").Range("a" & nSel + 2 & ":z" & nSel +
2).Hidden = True
End If
On Error GoTo 0
End If
Next
.TextColumn = tCol
Application.ScreenUpdating = True
End With
With Worksheets("Oculta")
With .UsedRange.Cells.SpecialCells(xlCellTypeVisible)
.Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Copy _
Worksheets("Favoritos").[a65536].End(xlUp).Offset(1, 0)
End With
.Rows.Hidden = False
End With
txtLibrosSeleccionados = 0
tarda = (Timer * 1000) - tarda
Debug.Print "tarda -> " & tarda
End Sub
'*****************************************************
Public Function BuscaFilas(ByVal Valor As Long, _
ByVal nHoja As String) As Long
On Error Resume Next
BuscaFilas = Evaluate("match(" & Valor & "," & nHoja & "!a:a,0)")
On Error GoTo 0
End Function

bueno, si se os ocurre algo sera bien recibido

un saludo y hasta pronto
Ivan

Siga el debate

6 respuestas

Tengo una respuesta

Preguntas similare

Leer las respuestas

#1 Ivan

13/12/2006 - 02:09 | Informe spam

perdon el otro codigo tenia fallos(y gordos)

este parece funcionar, pero sube a 22 segundos

Private Sub cmdActualizarFavoritos_Click()
Dim nSel As Long, CeldaO As Range, tCol As Long, tcol2 As Long
Dim tarda, x As Long
''pasa los libros seleccionados en lstSeleccionar a_
''la hoja "Favoritos"
tarda = Timer * 1000
Application.ScreenUpdating = False
With lstSeleccionar
tCol = .TextColumn: .TextColumn = 1
For nSel = .ListCount - 1 To 0 Step -1
If .Selected(nSel) = True Then
On Error Resume Next
If BuscaFilas(CLng(.List(nSel)), "Favoritos") > 0 Then
Worksheets("Oculta").Range("a" & nSel + 2).EntireRow.Hidden True
End If
On Error GoTo 0
End If
Next
.TextColumn = tCol
End With
With Worksheets("Oculta")
With .UsedRange.Cells.SpecialCells(xlCellTypeVisible)
If .Rows.Count > 1 Then
.Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Copy _
Worksheets("Favoritos").[a65536].End(xlUp).Offset(1, 0)
End If
End With
.Rows.Hidden = False
End With
txtLibrosSeleccionados = 0
Application.ScreenUpdating = True
tarda = (Timer * 1000) - tarda
Debug.Print "Con Hidden tarda -> " & tarda
End Sub

y esta es otra prueba previa que tarda aprox 33 segundos

Private Sub cmdActualizarFavoritos_Click()
Dim nSel As Long, CeldaO As Range, tCol As Long, tcol2 As Long
Dim tarda, x As Long
tarda = Timer * 1000: x = 2
With lstSeleccionar
tCol = .TextColumn: .TextColumn = 1
Application.ScreenUpdating = False
For nSel = 0 To .ListCount - 1
If .Selected(nSel) = True Then
On Error Resume Next
If BuscaFilas(CLng(.List(nSel)), "Favoritos") = 0 Then
Worksheets("Oculta").Range("a" & nSel + 2 & ":z" & nSel + 2)
_
.Copy Worksheets("Favoritos").Cells(x, 1)
x = x + 1
End If
On Error GoTo 0
End If
Next
.TextColumn = tCol
Application.ScreenUpdating = True
End With
txtLibrosSeleccionados = 0
tarda = (Timer * 1000) - tarda
Debug.Print "Con BuscaFilas y cells tarda -> " & tarda
End Sub

este mucho mas rapido con pocos registros seleccionados (y no pone en
blanco la pantalla como el otro)

un saludo de nuevo
Ivan

Responder a este mensaje

#2 Héctor Miguel

13/12/2006 - 07:37 | Informe spam

hola, Ivan !

considerando que el tiempo resulta un factor importante para 'optimizar' el resultado final de una seleccion multiple en un control de lista...
y que no podrias 'evitar' un escaneo/barrido/bucle/... -> POSTERIOR al proceso de seleccion multiple por parte del usuario [creo que]...
podrias dejarle el factor 'tardanza' al tiempo de decision del usuario [mientras se la esta pensando si de/selecciona unos u otros]...
si aprovechas el evento '_change' del control de lista para ocultar/mostrar la fila del elemento de/seleccionado 'en tiempo real'...

-> [seguramente] necesitaras una variable de tipo 'boolean' para indicarle al evento [_change] que no se dispare en la 'carga' de los datos
prueba con las siguientes lineas [o algo similar/parecido/adaptado/...] en el modulo de codigo del formulario...
[en sustitucion de los dos bloques 'With...End With' que utilizaste en ambos ejemplos]

Dim Cargando_datos As Boolean
Private Sub lstSeleccionar_Change()
If Cargando_datos Then Exit Sub
With lstSeleccionar
Worksheets("oculta").Range("a" & .ListIndex + 2).EntireRow.Hidden = _
.Selected(.ListIndex) And BuscaFilas(CLng(.List(.ListIndex)), "Favoritos") = 0
End With
End Sub

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

__ el codigo expuesto __

perdon el otro codigo tenia fallos(y gordos)
este parece funcionar, pero sube a 22 segundos
Private Sub cmdActualizarFavoritos_Click()
Dim nSel As Long, CeldaO As Range, tCol As Long, tcol2 As Long
Dim tarda, x As Long
''pasa los libros seleccionados en lstSeleccionar a la hoja "Favoritos"
tarda = Timer * 1000
Application.ScreenUpdating = False
With lstSeleccionar
tCol = .TextColumn: .TextColumn = 1
For nSel = .ListCount - 1 To 0 Step -1
If .Selected(nSel) = True Then
On Error Resume Next
If BuscaFilas(CLng(.List(nSel)), "Favoritos") > 0 Then
Worksheets("Oculta").Range("a" & nSel + 2).EntireRow.Hidden = True
End If
On Error GoTo 0
End If
Next
.TextColumn = tCol
End With
With Worksheets("Oculta")
With .UsedRange.Cells.SpecialCells(xlCellTypeVisible)
If .Rows.Count > 1 Then
.Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Copy _
Worksheets("Favoritos").[a65536].End(xlUp).Offset(1, 0)
End If
End With
.Rows.Hidden = False
End With
txtLibrosSeleccionados = 0
Application.ScreenUpdating = True
tarda = (Timer * 1000) - tarda
Debug.Print "Con Hidden tarda -> " & tarda
End Sub

y esta es otra prueba previa que tarda aprox 33 segundos

Private Sub cmdActualizarFavoritos_Click()
Dim nSel As Long, CeldaO As Range, tCol As Long, tcol2 As Long
Dim tarda, x As Long
tarda = Timer * 1000: x = 2
With lstSeleccionar
tCol = .TextColumn: .TextColumn = 1
Application.ScreenUpdating = False
For nSel = 0 To .ListCount - 1
If .Selected(nSel) = True Then
On Error Resume Next
If BuscaFilas(CLng(.List(nSel)), "Favoritos") = 0 Then
Worksheets("Oculta").Range("a" & nSel + 2 & ":z" & nSel + 2) _
.Copy Worksheets("Favoritos").Cells(x, 1)
x = x + 1
End If
On Error GoTo 0
End If
Next
.TextColumn = tCol
Application.ScreenUpdating = True
End With
txtLibrosSeleccionados = 0
tarda = (Timer * 1000) - tarda
Debug.Print "Con BuscaFilas y cells tarda -> " & tarda
End Sub

este mucho mas rapido con pocos registros seleccionados (y no pone en blanco la pantalla como el otro)

Responder a este mensaje

#3 Ivan

13/12/2006 - 08:42 | Informe spam

¡¡¡ Jod..!!! que se dice por ¿todos lados? no tengo tiempo de
probarlo ahora, pero el planteamiento es tan alucinante (al menos para
mi), que me va a tener en ascuas hasta que pueda hacerlo

hola, por cierto, Hector Miguel, muchas gracias de nuevo

un saludo y en cuanto pueda meterle mano te comento

Ivan

Responder a este mensaje

#4 Ivan

15/12/2006 - 03:33 | Informe spam

hola Hector Miguel,

disculpa la tardanza, pero he estado dandole vueltas a tu propuesta y
no queria responderte hasta haberla probado bien, o al menos haberlo
intentado..

como te comentaba en mi anterior post, la forma en que consigues
condensar en apenas dos lineas lo que a mi me hubiera costado no se
cuantas, me deja alucinado. Tambien la sintaxis que utilizas, con la
que ultimamente me he topado varias veces y que siempre me maravlla por
su 'sencilla' y evidente (a posteriori) logica, asi como por su
oportunismo,

bueno, volviendo al tema, creo que me va a venir muy bien el intentar
aprovechar los tiempos de in/decision del usuario (otra idea de oro que
a pesar de resultar evidente (a posteriori de nuevo) posiblemente no se
me hubiera ocurrido nunca),

en cuanto al codigo, aunque para las seleciones directas/o pequeñas en
el listbox parece ir muy bien, en lo que respecta a cargar todos los
registros sin repeticiones no he conseguido adaptarlo para aminorar el
tiempo. Incluso parece aumentar un poco.

<por cierto he cambiado el '= 0' final por '> 0', que me da la
impresion que es lo que querias poner. ¿o es otra de mis meteduras de
pata?>

¿quizas era a esto, a lo que te referias con esta frase? ->

y que no podrias 'evitar' un escaneo/barrido/bucle/... -> POSTERIOR al proceso de seleccion multiple por parte del usuario [creo que]...

¿ a que puedes intentar escamotear algun segundo de aqui y de alla,
pero que los barridos van a llevar su tiempo en cualquier caso?

como comenteba, no es algo demasiado importante pues no creo que sea
una opcion muy habitual(el seleccionar todos los reg. cuando sean
muchos), e incluso se podria avisar/preguntar antes de ejecutarse,

pero si se pudiera diminuir la espera estaria muy bien

bueno, a la idem de lo que se te ocurra, agradecerte de nuevo tu ayuda
y voy a seguir buscandole las cosquillas a tu ejemplo, a ver por donde
mas lo puedo colocar/adaptar

Por cierto ->>¿hay alguna norma que esblezca el orden en que se
evaluan las instrucciones/igualdades en esta especie de 'concatenacion'
de instrucciones, Por los casos que he visto me da la impresion de que
que empieza por el final, que parece lo logico, aunque a lo mejor estoy
diciendo una tonteria

un saludo y hasta pronto, y gracias de nuevo.
Ivan

Responder a este mensaje

#5 Héctor Miguel

15/12/2006 - 04:31 | Informe spam

hola, Ivan !

... para las seleciones directas/o peque#as en el listbox parece ir muy bien
en lo que respecta a cargar todos los registros sin repeticiones no he conseguido adaptarlo para aminorar el tiempo
Incluso parece aumentar un poco.

-> para una 'carga' de elementos sin duplicados, puedes emplear diferentes metodos [p.e.]
- los filtros avanzados, objetos 'Dictionary', objetos 'Collection' [para no muchos elementos], etc.
[dependera de numero de elementos y probablemente otras 'circunstancias'] ;)

por cierto he cambiado el '= 0' final por '> 0', que me da la impresion que es lo que querias poner. o es otra de mis meteduras de pata?
quizas era a esto, a lo que te referias con esta frase? ->

y que no podrias 'evitar' un escaneo/barrido/bucle/... -> POSTERIOR al proceso de seleccion multiple por parte del usuario [creo que]...

-> [en realidad] note que en tu codigo exponias las dos 'variantes'... una con la igualdad a cero, y otra buscando un resultado mayor a cero
[honestamente]... no me puse a buscar cual era el 'efecto' entre ambas [ocultar la fila y/o copiar los datos] :-(

a que puedes intentar escamotear algun segundo de aqui y de alla, pero que los barridos van a llevar su tiempo en cualquier caso?

-> los 'barridos' [por si solos] ya consumen 'su tiempo' [aunque en ocasiones resulta 'excesivo'] :))

... no es algo demasiado importante pues no creo que sea una opcion muy habitual
(el seleccionar todos los reg. cuando sean muchos), e incluso se podria avisar/preguntar antes de ejecutarse,
pero si se pudiera diminuir la espera estaria muy bien

-> [supongo que] cuando se 'deban/decida/...' seleccionar TODOS los elementos del control de lista...
[probablemente] te convendria 'mantener' una lista 'aparte' [p.e. la que se hubiera utilizado para el llenado del control] -?-

... hay alguna norma que establezca el orden en que se evaluan las instrucciones/igualdades en esta... 'concatenacion' de instrucciones
... me da la impresion de que que empieza por el final, que parece lo logico [...]

-> [hasta donde se] existen 'prioridades' en el orden de 'evaluacion' de instrucciones en codigo
aunque [siendo honesto]... no 'veo' por donde 'encaja la pregunta' en el orden de esta consulta [bucles ?, estructuras ?, ???]

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Responder a este mensaje

Ads by Google

Hacer una preguntaSiguiente

Tengo una respuesta

Busqueda sugerida