Jump to content
Sign in to follow this  
ferminote

Excel con macro se ha vuelto lentaaaaaa

Recommended Posts

Buenas tardes.

El problema ahora es que cuando metemos en HOJA SOCIOS unos 700 fulanos, el sistema de busqueda y todo en general se vuelve lentiiiisimo.

Por ej. al cambiar el orden de busqueda, buscar por nombre, dar entrada... unos 5-12 segundos dependiendo del PC utilizado.

Cuando habia 25-50 socios todo iba perfecto, pero segun se incrementa el numero se vuelve Lento.

a ver, he probado a usar esto que encontre

AL INICIO DE MACRO
Sub iniciamacro()

Application.screenupdating=False
Application.calculation=xlCalculationManual
Application.EnableEvents=False
ActiveSheet.DisplayPageBreaks = False

End Sub

AL FINAL DE MACRO
Sub borracache()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub[/CODE]

Pero no se si lo he puesto en mal sitio o simplemente no hace nada.

subo archivo con 700 fulanos...

Gracias por adelantado

gestionbeta2.rar

Share this post


Link to post
Share on other sites

GENIAL!!!

como rapido, va rapido como las balas, pero me da errores. :(

Al pulsar entada o salida, al clickar en NUEVO o ACTUALIZAR

Private Sub ActualizarListas(Optional Opción As String = "")

TextBox1 = WorksheetFunction.Sum(Hoy.Range("J1:J" & Hoy.Range("J" & Rows.Count).End(xlUp).Row))

If Opción = "J" Or Opción = Empty Then
If Hoy.Range("A1") <> "" Then
Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Lista.ListCount - 1
If Jaula.List(x, 7) <> "" Then ------AQUI------
Jaula.List(x, 7) = Format(Jaula.List(x, 7), "hh:mm")
End If
If Jaula.List(x, 8) <> "" Then
Jaula.List(x, 8) = Format(Jaula.List(x, 8), "hh:mm")
End If
Next
End If
End If[/CODE]

PD: creo que las columnas a formatear HH:MM son la 8 y 9, no 7 y 8. Y lo digo desde la mas amplia de las ignorancias. :D

PD2: La SUB Actualizarlistas2 (que es la que va lenta) se puede eliminar, no?

Un saludo!!!

Share this post


Link to post
Share on other sites

Ok.

elimino actualizarlistas2 y actualizarlistas lo dejo asi (he añadido ademas la columna 2 para formatear HH:MM), las correctas son 2,7 y 8 creo (corresponden a las columnas de HORA,SALIDA y TIEMPO)


Private Sub ActualizarListas(Optional Opción As String = "")

TextBox1 = WorksheetFunction.Sum(Hoy.Range("J1:J" & Hoy.Range("J" & Rows.Count).End(xlUp).Row))

If Opción = "J" Or Opción = Empty Then

Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Lista.ListCount - 1
If Jaula.List(x, 2) <> "" Then
Jaula.List(x, 2) = Format(Jaula.List(x, 2), "hh:mm")
End If
If Jaula.List(x, 7) <> "" Then
Jaula.List(x, 7) = Format(Jaula.List(x, 7), "hh:mm")
End If
If Jaula.List(x, 8) <> "" Then
Jaula.List(x, 8) = Format(Jaula.List(x, 8), "hh:mm")
End If
Next
End If


If Opción = "L" Or Opción = Empty Then
Lista.List = Socios.Range("A2:F" & Socios.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Lista.ListCount - 1
If Lista.List(x, 4) <> "" Then
Lista.List(x, 4) = Format(Lista.List(x, 4), "hh:mm")
End If
If Lista.List(x, 5) <> "" Then
Lista.List(x, 5) = Format(Lista.List(x, 5), "hh:mm")
End If
Next
End If
End Sub
[/CODE]

El error que me dá el depurador es que no puede obtener la propiedad .list de (If Jaula.List(x, 3) <> "" Then)

Entiendo que no sabe lo que es (x, 3) ????

Por otro lado he probado a eliminar las lineas :

[CODE]If Jaula.List(x, 2) <> "" Then
Jaula.List(x, 2) = Format(Jaula.List(x, 2), "hh:mm")
End If
If Jaula.List(x, 7) <> "" Then
Jaula.List(x, 7) = Format(Jaula.List(x, 7), "hh:mm")
End If
If Jaula.List(x, 8) <> "" Then
Jaula.List(x, 8) = Format(Jaula.List(x, 8), "hh:mm")[/CODE]

y la hoja funciona, pero no me formatea las columnas necesarias a HH:MM claro....

Share this post


Link to post
Share on other sites

.

A veces los árboles no nos dejan ver el bosque:

En lugar de:

      Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Lista.ListCount - 1 '<==============
[/CODE]

[b][u]Debe ser:[/u][/b]

[CODE] Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Jaula.ListCount - 1 '<==============
[/CODE]

.

Share this post


Link to post
Share on other sites

Mecawuen!!! :mad::eek::mad::eek:

Si los ojitos me dolían ya de mirar!!! Juro que repase esa parte mas de 20 veces!!!

Solo ha quedado una cosa rara (no da error) pero al Cerrar Jornada (pestaña salidas) queda como un duplicado de los enunciados y 2 checkbox vacios, ando rebuscando por si algun A2 es un A1 por error....

Share this post


Link to post
Share on other sites

A ver, he localizado donde esta el problema :mad:, pero no la solucion...:mad:

si cambio

Private Sub ActualizarListas(Optional Opción As String = "")

TextBox1 = WorksheetFunction.Sum(Hoy.Range("J1:J" & Hoy.Range("J" & Rows.Count).End(xlUp).Row))

If Opción = "J" Or Opción = Empty Then
Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Jaula.ListCount - 1
If Jaula.List(x, 2) <> "" Then
Jaula.List(x, 2) = Format(Jaula.List(x, 2), "hh:mm")
End If
If Jaula.List(x, 7) <> "" Then
Jaula.List(x, 7) = Format(Jaula.List(x, 7), "hh:mm")
End If
If Jaula.List(x, 8) <> "" Then
Jaula.List(x, 8) = Format(Jaula.List(x, 8), "hh:mm")
End If
Next
End If
[/CODE]

por el antiguo codigo...

[CODE]Private Sub ActualizarListas(Optional Opción As String = "")

TextBox1 = WorksheetFunction.Sum(Hoy.Range("J1:J" & Hoy.Range("J" & Rows.Count).End(xlUp).Row))

If Opción = "J" Or Opción = Empty Then
Jaula.Clear
If Hoy.Range("A1") <> "" Then
For x = 2 To Hoy.Range("A" & Rows.Count).End(xlUp).Row
Jaula.AddItem
For y = 1 To 10: Jaula.List(Jaula.ListCount - 1, y - 1) = Hoy.Cells(x, y): Next
Jaula.List(Jaula.ListCount - 1, 2) = Format(Hoy.Cells(x, 3), "hh:mm")
If Hoy.Cells(x, 8) <> "" Then
Jaula.List(Jaula.ListCount - 1, 7) = Format(Hoy.Cells(x, 8), "hh:mm")
End If
If Hoy.Cells(x, 9) <> "" Then
Jaula.List(Jaula.ListCount - 1, 8) = Format(Hoy.Cells(x, 9), "hh:mm")
End If
Next
End If
End If[/CODE]

Ya no ocurre el fallo de que al cerrar jornada quede en la linea 2 un duplicado de las cabeceras (

FECHA HORA SOCIO NOMBRE TELEFONO PULSERA SALIDA TIEMPO IMPORTE)

ademas sigue funcionando rápido, pero entiendo que el primer codigo es mas eficiente y deberia usar ese.

He probado a hacer cambios, pero no lo consigo...

Tambien he mirado en el procedimiento

[CODE]Private Sub Cerrar_Click()

If MsgBox("¿ Desea cerrar la jornada de trabajo ? , ¡¡¡el listado de Niños se Borrara!!!", vbQuestion + vbYesNo) = vbNo Then Exit Sub
MsgBox ("LA CAJA TOTAL DEL DIA ES : " & TextBox1.Text & " EUROS")

Socios.Range("O12") = TextBox1.Text & " EUROS"
Socios.Range("N6:O12").PrintOut

Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Copy _
Histórico.Range("A" & Histórico.Range("A" & Rows.Count).End(xlUp).Row + 1)
Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
Socios.Range("E:F").ClearContents
ActualizarListas
End Sub[/CODE]

pero no hay cambios hay....

¿que puede ser? ¿los arboles otra vez? Al final me hago leñador:mad::mad::mad:

Share this post


Link to post
Share on other sites

Pues el caso es que si lo habia probado, pero aun asi da el fallo

Tambien probé insertar

Jaula.Clear

Jaula.AddItem

Fruto de la desesperacion:eek:.... pero nada que no hay manera...

Private Sub ActualizarListas(Optional Opción As String = "")

TextBox1 = WorksheetFunction.Sum(Hoy.Range("J1:J" & Hoy.Range("J" & Rows.Count).End(xlUp).Row))

If Opción = "J" Or Opción = Empty Then
If Hoy.Range("A1") <> "" Then

Jaula.List = Hoy.Range("A2:J" & Hoy.Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 0 To Jaula.ListCount - 1
If Jaula.List(x, 2) <> "" Then
Jaula.List(x, 2) = Format(Jaula.List(x, 2), "hh:mm")
End If
If Jaula.List(x, 7) <> "" Then
Jaula.List(x, 7) = Format(Jaula.List(x, 7), "hh:mm")
End If
If Jaula.List(x, 8) <> "" Then
Jaula.List(x, 8) = Format(Jaula.List(x, 8), "hh:mm")
End If
Next
End If
End If
[/CODE]

gestionbeta2 Rápido3.rar

Share this post


Link to post
Share on other sites
Jajaja, me parto la caja. ¿ Donde está esta línea en el procedimiento nuevo ?

 If Hoy.Range("A1") <> "" Then[/CODE]

No te olvides de poner el [b]End If[/b].

Por un detallito de nada:

[CODE]
Jaula.Clear
If Hoy.Range("A2") <> "" Then[/CODE]

.

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.

Sign in to follow this  



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png