Soy nuevo en este foro y desde ya agradezco la creación en este foro, sus importantes aportes y la ayuda que me puedan brindar.
Necesito que me puedan ayudar por favor, en la optimización de una macro (realizada en Excel 2007) , ya que, se demora bastante tiempo en ejecutarla y como la ocupo varias veces al día se me hace MUY necesario el poder hacer que corra mas rápido.
He probado con distintos códigos, entre ellos, agregar al inicio y al final de la macro, las siguientes sentencias.
Al inicio:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Al final:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Entre otras cosas, pero NADA me resulta... el proceso se sigue demorando aproximadamente 20 minutos.
Así que les pido de favor que me puedan ayudar!!
Muchas Gracias!
PD: Les adjunto el código:
Public Const hoja_macro As Integer = 1 ' numero (indice) de la hoja macro
Public Const hoja_frecuencia As Integer = 2 'numero (indice) de la hoja frecuencia
Public Const hoja_velocidad As Integer = 3 'numero (indice) de la hoja velocidad
Public Const hoja_distancia As Integer = 4 'numero (indice) de la hoja ditancia
Public Const hoja_capacidad As Integer = 5 'numero (indice) de la hoja capacidad
Public Const hoja_flota As Integer = 6 'numero (indice) de la hoja flota
Public Const max_servicio As Integer = 800 ' maxima cantidad de servicios del sistema
Public Const max_periodo As Integer = 29 ' cantidad de periodos
' funcion que retorna la fila donde se encuentra el servicio buscado
Function buscar_ss(servicio As String, sentido As String, indice_hoja As Integer)
For i = 1 To max_servicio
If UCase(Sheets(indice_hoja).Cells(i, 2)) = UCase(servicio) And UCase(Sheets(indice_hoja).Cells(i, 3)) = UCase(sentido) Then
buscar_ss = i
Exit Function
End If
Next
End Function
Sub traspone()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
limpiar ' funcion para limpiar datos de hoja macro
fila = 2 ' para ir escribiendo a partir de la fila 2 en hoja macro
For i = 1 To max_servicio ' recorrer filas hasta el maximo de servicios definidos
For j = 1 To max_periodo ' recorrer columnas hasta la cantidad de periodos definidos
If Sheets(hoja_frecuencia).Cells(i + 6, 1) <> "" Then ' recorrer filas hasta pillar celda vacio, lo que significa que no hay mas datos
'aqu se va rellenando fila por fila la informacion en la hoja macro
Estimados,
Soy nuevo en este foro y desde ya agradezco la creación en este foro, sus importantes aportes y la ayuda que me puedan brindar.
Necesito que me puedan ayudar por favor, en la optimización de una macro (realizada en Excel 2007) , ya que, se demora bastante tiempo en ejecutarla y como la ocupo varias veces al día se me hace MUY necesario el poder hacer que corra mas rápido.
He probado con distintos códigos, entre ellos, agregar al inicio y al final de la macro, las siguientes sentencias.
Al inicio:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Al final:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Entre otras cosas, pero NADA me resulta... el proceso se sigue demorando aproximadamente 20 minutos.
Así que les pido de favor que me puedan ayudar!!
Muchas Gracias!
PD: Les adjunto el código:
Public Const hoja_macro As Integer = 1 ' numero (indice) de la hoja macro
Public Const hoja_frecuencia As Integer = 2 'numero (indice) de la hoja frecuencia
Public Const hoja_velocidad As Integer = 3 'numero (indice) de la hoja velocidad
Public Const hoja_distancia As Integer = 4 'numero (indice) de la hoja ditancia
Public Const hoja_capacidad As Integer = 5 'numero (indice) de la hoja capacidad
Public Const hoja_flota As Integer = 6 'numero (indice) de la hoja flota
Public Const max_servicio As Integer = 800 ' maxima cantidad de servicios del sistema
Public Const max_periodo As Integer = 29 ' cantidad de periodos
' funcion que retorna la fila donde se encuentra el servicio buscado
Function buscar_ss(servicio As String, sentido As String, indice_hoja As Integer)
For i = 1 To max_servicio
If UCase(Sheets(indice_hoja).Cells(i, 2)) = UCase(servicio) And UCase(Sheets(indice_hoja).Cells(i, 3)) = UCase(sentido) Then
buscar_ss = i
Exit Function
End If
Next
End Function
Sub traspone()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
limpiar ' funcion para limpiar datos de hoja macro
fila = 2 ' para ir escribiendo a partir de la fila 2 en hoja macro
For i = 1 To max_servicio ' recorrer filas hasta el maximo de servicios definidos
For j = 1 To max_periodo ' recorrer columnas hasta la cantidad de periodos definidos
If Sheets(hoja_frecuencia).Cells(i + 6, 1) <> "" Then ' recorrer filas hasta pillar celda vacio, lo que significa que no hay mas datos
'aqu se va rellenando fila por fila la informacion en la hoja macro
'///////////////////////////////////////////
Sheets(hoja_macro).Cells(fila, 1) = Sheets(hoja_frecuencia).Cells(i + 6, 1) ' unidad
Sheets(hoja_macro).Cells(fila, 2) = Sheets(hoja_frecuencia).Cells(i + 6, 2) ' servicio
Sheets(hoja_macro).Cells(fila, 3) = Sheets(hoja_frecuencia).Cells(i + 6, 3) ' sentido
Sheets(hoja_macro).Cells(fila, 4) = Sheets(hoja_frecuencia).Cells(1, j + 3) ' periodo
Sheets(hoja_macro).Cells(fila, 5) = Sheets(hoja_frecuencia).Cells(buscar_ss(Sheets(hoja_frecuencia).Cells(i + 6, 2), Sheets(hoja_frecuencia).Cells(i + 6, 3), 2), j + 3)
Sheets(hoja_macro).Cells(fila, 6) = Sheets(hoja_velocidad).Cells(buscar_ss(Sheets(hoja_frecuencia).Cells(i + 6, 2), Sheets(hoja_frecuencia).Cells(i + 6, 3), 3), j + 3)
Sheets(hoja_macro).Cells(fila, 7) = Sheets(hoja_distancia).Cells(buscar_ss(Sheets(hoja_frecuencia).Cells(i + 6, 2), Sheets(hoja_frecuencia).Cells(i + 6, 3), 4), j + 3)
Sheets(hoja_macro).Cells(fila, 8) = Sheets(hoja_capacidad).Cells(buscar_ss(Sheets(hoja_frecuencia).Cells(i + 6, 2), Sheets(hoja_frecuencia).Cells(i + 6, 3), 5), j + 3)
Sheets(hoja_macro).Cells(fila, 9) = Sheets(hoja_flota).Cells(buscar_ss(Sheets(hoja_frecuencia).Cells(i + 6, 2), Sheets(hoja_frecuencia).Cells(i + 6, 3), 6), j + 3)
fila = fila + 1
End If
Next
Next
MsgBox "proceso terminado con exito !! revisa resultados"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
Sub limpiar() ' funcion para limpiar datos de la hoja macro
'
' limpiar Macro
'
'
Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End Sub
' funcion para agregar letra T a los troncales
Sub formato()
For i = 1 To 23000
If Sheets(hoja_macro).Cells(i, 1) Like "*T*" Then
Sheets(hoja_macro).Cells(i, 2) = "T" & Sheets(hoja_macro).Cells(i, 2)
End If
Next
End Sub