Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Lentitud en Macros

21/01/2009 - 18:50 por Paola | Informe spam
Ayuda Hacer una pregunta
Solicito apoyo, ya que quisiera saber porque tardan tanto en correr algunas
macros en Oficce 2007, mas del doble de las que corro en Office 2003. He
modificado la memoria virtual del equipo y ha mejorado un poco la velocidad.
Podría alguien decirme si hay algo que se pueda modificar directamente en el
Office 2007 para eficientar las macros.
Comento que este equipo es nuevo, tiene 2 GB de Ram, procesador Core2Duo
T8300 donde se alentan el doble las macros. El equipo anterior tenia 512MB
procesador Pentium con 1GB de Ram.

Gracias.
email Siga el debateRespuesta 5 respuestasRespuesta Tengo una respuesta

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
22/01/2009 - 03:02 | Informe spam
hola, Paola !

... quisiera saber porque tardan tanto en correr algunas macros en Oficce 2007, mas del doble de las que corro en Office 2003.
He modificado la memoria virtual del equipo y ha mejorado un poco la velocidad.
Podria alguien decirme si hay algo que se pueda modificar directamente en el Office 2007 para eficientar las macros.
Comento que este equipo es nuevo, tiene 2 GB de Ram, procesador Core2Duo T8300 donde se alentan el doble las macros.
El equipo anterior tenia 512MB procesador Pentium con 1GB de Ram.



no se si seas tu quien:
- en noviembre de 2006 consultaba acerca de un archivo "con varias macros" que constantemente generaba errores
- en noviembre de 2008 consultaba acerca de ejecutar macros (en excel 2007) de un archivo con clave/cifrado -?-

por lo que respecta a esta consulta, notaras que la version 2007 es "diferente" (sobre todo) en su interfaz grafica
razon por la que su requerimitento de recursos tambien se comporta diferente (p.e.)

es probable que tus macros incluyan instrucciones del tipo <objeto_celda>.Select u <objeto_hoja>.Activate
instrucciones que efectivmente hacen "seleccion de objetos" (como en la interfaz grafica con el usuario)

y/o que las macros sean "varias" y lleguen a causar algun riesgo de corrupcion

(o sea) causas "posibles" ?... podrian ser mas de dos (pero cuales ?... solo "viendo")

saludos,
hector.
Respuesta Responder a este mensaje
#2 Paola
22/01/2009 - 19:11 | Informe spam

> ... quisiera saber porque tardan tanto en correr algunas macros en Oficce 2007, mas del doble de las que corro en Office 2003.
> He modificado la memoria virtual del equipo y ha mejorado un poco la velocidad.
> Podria alguien decirme si hay algo que se pueda modificar directamente en el Office 2007 para eficientar las macros.
> Comento que este equipo es nuevo, tiene 2 GB de Ram, procesador Core2Duo T8300 donde se alentan el doble las macros.
> El equipo anterior tenia 512MB procesador Pentium con 1GB de Ram.

no se si seas tu quien:
- en noviembre de 2006 consultaba acerca de un archivo "con varias macros" que constantemente generaba errores
- en noviembre de 2008 consultaba acerca de ejecutar macros (en excel 2007) de un archivo con clave/cifrado -?-

por lo que respecta a esta consulta, notaras que la version 2007 es "diferente" (sobre todo) en su interfaz grafica
razon por la que su requerimitento de recursos tambien se comporta diferente (p.e.)

es probable que tus macros incluyan instrucciones del tipo <objeto_celda>.Select u <objeto_hoja>.Activate
instrucciones que efectivmente hacen "seleccion de objetos" (como en la interfaz grafica con el usuario)

y/o que las macros sean "varias" y lleguen a causar algun riesgo de corrupcion

(o sea) causas "posibles" ?... podrian ser mas de dos (pero cuales ?... solo "viendo")

saludos,
hector.



Hola Héctor,
Contestando a lo que me preguntas, no soy la persona que consultaba en 2006,
pero creo que sí a la que le dijiste como modificar en el regedit lo de la
clave cifrada en un archivo excel2007.
Ahora con respecto a la lentitud tan considerada con macros en excel2007 a
comparacion de 2003. Te comento que las macros tienen instrucciones de tipo
ActiveCell, pero te adjunto código para que lo veas, gracias por tu apoyo:
Public acc_no As String
Public A_RN As String
Public AS_RN As String
Public mon As String
Public col As String
Public x As Single
Public col2 As String
Public i As Single
Public CO As String
Public acc_start1 As String
Public acc_start2 As String
Public acc_start3 As String
Public acc_end1 As String
Public acc_end2 As String
Public acc_end3 As String
Public model_name As String
Public input_name As String
Public out_start As String
Public out_end As String
Public ass_sheet As String
Public cal_sheet As String
Public company_col As String
Public ass_sheet_ref As String

Sub Formula_creator()

'Inhabilita el cambio o movimiento del cursor y pantallas durante el
desarrollo de la macro _
y el cálculo automático de excel. Ahorra memoria y tiempo.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Q = 1 To 17 'For Q = 1 To 17

A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
"a-mid", "a-mtt", "a-oax", _
"a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
"a-elim_cun")

C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
"c-mid", "c-mtt", "c-oax", _
"c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
"c-elim_cun")


C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s")

A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
"'a-czm'!", "'a-hux'!", "'a-mid'!", _
"'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
"'a-ras'!", "'a-gas'!", _
"'a-elim_asur'!", "'a-elim_cun'!")

ass_sheet = A_X 'Assumptions sheet
cal_sheet = C_X 'Calculation sheet
company_col = C_COL 'Company column
ass_sheet_ref = A_X2 'Assumption reference sheet

For x = 1 To 13 'For x = 1 To 13

mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
"jun", "jul", "aug", "sep", "oct", _
"nov", "dec")

col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
"r", "s", "t")

col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
"p", "q", "r")


Sheets(cal_sheet).Select
Range("D9").Activate 'Original Range("D9").Activate
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate
Loop

Do Until ActiveCell.Value = "STOP"

If ActiveCell.Value = "" Then
Else
acc_no = ActiveCell.Value

find_actual_RN

find_assumption_RN

Sheets(cal_sheet).Select

'Proceso inhabilitado.
' If acc_no < 4000 Then
' ActiveCell.Offset(1, 0).Activate
' Else

If Selection.Interior.ColorIndex = 15 Then


ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col &
"$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" & company_col
& A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address _
& ":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0),IF(COLUMN(" _
& col & "$2)<=9,0,sum(" & ActiveCell.Offset(1,
5).Address & ":" & _
ActiveCell.Offset(1, 2 + x).Address & "))*" & col &
"6)*R_F"
Else
If ActiveCell.Offset(0, -1).Value = "C" Then

back = ActiveCell.Address

Sheets(cal_sheet).Select 'Selecciona la hoja de
cálculo
Range("D800").Activate


Do While ActiveCell.Row < 1200
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
C_RN = ActiveCell.Row
'Calculation row number número
de renglón.

Exit Do
Else
C_RN = 1500
End If
Loop

Range(back).Activate
'Regresa a la celda de la cuenta cuya columna c
tiene una "C"

If ActiveCell.Offset(0, -1).Interior.ColorIndex = 15
Then 'Si además, tiene color _
gris, genera la siguiente fórmula
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
col & "$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" &
company_col & A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address & _
":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0)," & col & C_RN & ")*R_F"

Else
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
col & "$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" &
company_col & A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address & _
":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0)," & col & C_RN & ")"

End If

Else
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col & "$4" &
"," & ActiveCell.Offset(0, -2).Value & _
mon & "!" & company_col & A_RN & "-IF(COLUMN(" & col &
"$2)>9,sum(" & ActiveCell.Offset(0, 5).Address & ":" & _
ActiveCell.Offset(0, 3 + x - 1).Address & "),0)," &
ass_sheet_ref & col & AS_RN & ")"

End If
End If
End If

ActiveCell.Offset(1, 0).Activate
acc_no = ActiveCell.Value
' End If
Loop

Next x

Next Q

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Formula_creator_assets

End Sub

Sub Formula_creator_assets()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'ass_sheet = "a-cun"
'cal_sheet = "c-cun"
'company_col = "c"
'ass_sheet_ref = "'a-cun'!"

For Q = 1 To 17 'For Q = 1 To 17

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
"a-mid", "a-mtt", "a-oax", _
"a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
"a-elim_cun")

C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
"c-mid", "c-mtt", "c-oax", _
"c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
"c-elim_cun")


C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s")

A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
"'a-czm'!", "'a-hux'!", "'a-mid'!", _
"'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
"'a-ras'!", "'a-gas'!", _
"'a-elim_asur'!", "'a-elim_cun'!")

ass_sheet = A_X 'Assumptions sheet
cal_sheet = C_X 'Calculation sheet
company_col = C_COL 'Company column
ass_sheet_ref = A_X2 'Assumption reference sheet

For x = 1 To 13 'For x = 1 To 13


mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
"jun", "jul", "aug", "sep", "oct", _
"nov", "dec")

col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
"r", "s", "t")

col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
"p", "q", "r")


Sheets(cal_sheet).Select
Range("E413").Activate 'Original Range("E413").Activate

Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate
Loop
Do Until ActiveCell.Value = "STOP"
If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Activate
Else
acc_no = ActiveCell.Value
find_actual_RN
find_assumption_RN
Sheets(cal_sheet).Select
If ActiveCell.Offset(0, -2).Value = "DEP" Then
ActiveCell.Offset(0, 2 + x).Formula = "=choose("
& col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon & "!" &
company_col & A_RN & "," _
& ActiveCell.Offset(0, 1 + x).Address & "- " &
ass_sheet_ref & col & AS_RN & ")"
Else
If ActiveCell.Offset(0, -2).Value = "DEP_R"
Then
ActiveCell.Offset(0, 2 + x).Formula =
"=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon &
"!" & company_col & A_RN & "," _
& ActiveCell.Offset(1, 1 + x).Address &
"*(1+" & col & "$6)- " & _
ass_sheet_ref & col & AS_RN & "-" &
ActiveCell.Offset(-1, 2 + x).Address & ")*R_F"
Else
If ActiveCell.Offset(0, -2).Value =
"F" Then
ActiveCell.Offset(0, 2 + x).Formula
= "=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon
& "!" & company_col & A_RN & "," & _
ActiveCell.Offset(0, 1 + x).Address
& ")"


Else
If ActiveCell.Offset(0,
-2).Value = "R" Then
ActiveCell.Offset(0, 2 +
x).Formula = "=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0,
-3).Value & mon & "!" & company_col & A_RN & "," _
& ActiveCell.Offset(0, 1 +
x).Address & "+" & ActiveCell.Offset(1, 1 + _
x).Address & "*" & col &
"$6)*R_F"


Else
If
ActiveCell.Offset(0, -2).Value = "C" Then
back =
ActiveCell.Address

Sheets(cal_sheet).Select

Range("D800").Activate
Do While
ActiveCell.Row < 1200

ActiveCell.Offset(1, 0).Activate
If
ActiveCell.Value = acc_no Then

C_RN = ActiveCell.Row
Exit
Do

Else

C_RN = 1500
End If
Loop

Range(back).Activate
If
ActiveCell.Offset(0, -2).Interior.ColorIndex _
= 15
Then

ActiveCell.Offset(0, 2 + x).Formula = _

"=choose(" & col & "$4" & "," & ActiveCell.Offset _

(0, -3).Value & mon & "!" & company_col & A_RN _

& "," & col & C_RN & ")*R_F"





Else

ActiveCell.Offset(0, 2 + x).Formula = _

"=choose(" & col & "$4" & "," & ActiveCell.Offset _

(0, -3).Value & mon & "!" & company_col & A_RN _

& "," & col & C_RN & ")"
End If
Else

ActiveCell.Offset(0, 2 + x).Formula = "=choose(" _

& col & "$4" & "," & ActiveCell.Offset(0, -3).Value & _

mon & "!" & company_col & A_RN & ",0)"

End If

End If

End If

End If

End If
ActiveCell.Offset(1, 0).Activate
acc_no = ActiveCell.Value
End If
Loop
Next x
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Next Q
Sheets("Manager").Select
Range("A1").Activate
End Sub

Sub find_actual_RN()

Choose(x, Sheet6, Sheet7, Sheet8, Sheet9, Sheet10, Sheet11, Sheet12,
Sheet13, Sheet14, Sheet15, Sheet16, _
Sheet17, Sheet18).Select
'Selecciona X como mes sheet6=Dec n-1, Sheet7=Jan y así es por
la posición de las _

Range("A10").Activate
Do While ActiveCell.Row < 700 'Ok 700 son suficientes
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
A_RN = ActiveCell.Row

Exit Do
Else
A_RN = 1500
End If
Loop
End Sub

Sub find_assumption_RN()
Sheets(ass_sheet).Select

Range("c1").Activate
Do While ActiveCell.Row < 550
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
AS_RN = ActiveCell.Row
'Assumption row number número de renglón.
Exit Do
Else
AS_RN = 1500

End If
Loop
End Sub

Sub find_calculation_RN()

Sheets(cal_sheet).Select
Range("d727").Activate
Do While ActiveCell.Row < 1200
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
C_RN = ActiveCell.Row
Exit Do
Else

C_RN = 1500

End If
Loop


End Sub
Sub Import_asset_values()

model_name = ActiveWorkbook.Name

Create_export_assets

inport_mon = Application.InputBox("enter month of inport", "Import of assets
values", , , , , , 2)

Workbooks(input_name).Worksheets("output").Activate

Range(Range(out_start).Offset(0, 1).Address, out_end).Copy

Workbooks(model_name).Worksheets(inport_mon).Activate

Range("b15").Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
Loop

ActiveCell.PasteSpecial (xlPasteValues)


End Sub
Sub Create_export_assets()

'START the opning detaild balance code

fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")


Response = MsgBox("open" & fileToOpen, vbYesNo, "Open")
If Response = vbYes Then ' User chose Yes.
Workbooks.Open (fileToOpen) ' Perform some action.

input_name = ActiveWorkbook.Name

'END the opning detaild balance code - IF opning

'START creating combinded account number


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets.Add.Name = "Output"

For i = 1 To 15

CO = Choose(i, "CUN", "CZM", "HUX", "MID", "MTT", "OAX", "TAP", "VER",
"VSA", "SAS", "GAS", "CARGA", "FBO", "98", "96")


Worksheets(CO).Activate

Range("a11").Activate


Do Until ActiveCell.Value = "Saldo Final"
ActiveCell.Offset(0, 1).Activate
Loop

ActiveCell.Offset(2, 1).Activate

Do Until ActiveCell.Offset(0, -1).Value = ""
ActiveCell.Formula = "=" & ActiveCell.Offset(0, -5).Address
ActiveCell.Offset(0, 1).Formula = "=" & ActiveCell.Offset(0, -1).Address
ActiveCell.Offset(0, 2).Formula = "= mid(" & ActiveCell.Offset(0,
-4).Address & ",4,28)"

ActiveCell.Offset(1, 0).Activate

Loop

Next i

Application.Calculation = xlCalculationAutomatic


'START copy the account structur form CUN

Worksheets("CUN").Activate

Find_assets_accounts

'START copy assets accounts form CUN


Range(acc_start1, acc_end1).Copy

Worksheets("Output").Activate
Range("d5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Worksheets("CUN").Activate
Range(acc_start2, acc_end2).Copy

Worksheets("Output").Activate
Range("e5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Worksheets("CUN").Activate
Range(acc_start3, acc_end3).Copy

Worksheets("Output").Activate
Range("u5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'END copy assets accounts form CUN


Application.Calculation = xlCalculationManual

For i = 2 To 15

CO = Choose(i, "CUN", "CZM", "HUX", "MID", "MTT", "OAX", "TAP", "VER",
"VSA", "SAS", "GAS", "CARGA", "FBO", "98", "96")


Worksheets(CO).Activate
Range("a13").Activate

Do Until ActiveCell.Value > "1800"
ActiveCell.Offset(1, 0).Activate

Loop

Do Until ActiveCell.Value > "2000"
acc_n = ActiveCell.Offset(0, 6).Value
acc_v = ActiveCell.Offset(0, 7).Value
acc = ActiveCell.Offset(0, 8).Value
ActiveCell.Offset(1, 0).Activate


With Worksheets("output").Range("u5:u500")
Set C = .Find(acc, LookIn:=xlValues)
If Not C Is Nothing Then

C.Offset(0, -17 + i).Value = acc_v

Else


Worksheets("output").Activate

Range("d10").Activate

Do Until ActiveCell.Value = ""

ActiveCell.Offset(1, 0).Activate

Loop

ActiveCell.Value = acc_n
ActiveCell.Offset(0, 0 + i).Value = acc_v
ActiveCell.Offset(0, 17).Value = acc


End If
End With

Worksheets(CO).Activate


Loop

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


adjust_output_data
Else

End If

End Sub

Sub Find_assets_accounts()

'START Find the assets accounts

Range("a13").Activate

Do Until ActiveCell.Value > "1800"
ActiveCell.Offset(1, 0).Activate

Loop

acc_start1 = ActiveCell.Offset(0, 6).Address
acc_start2 = ActiveCell.Offset(0, 7).Address
acc_start3 = ActiveCell.Offset(0, 8).Address


Do Until ActiveCell.Value > "2000"
ActiveCell.Offset(1, 0).Activate

Loop
acc_end1 = ActiveCell.Offset(-1, 6).Address
acc_end2 = ActiveCell.Offset(-1, 7).Address
acc_end3 = ActiveCell.Offset(-1, 8).Address

'END Find the assets accounts


End Sub

Sub adjust_output_data()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets("output").Activate

Range("u5").Activate

Do Until ActiveCell.Value = ""

ActiveCell.Offset(0, -18).Formula = "=mid(" & ActiveCell.Address & ",6,10)"
ActiveCell.Offset(0, -20).Formula = "=value(mid(" & ActiveCell.Offset(0,
-18).Address & ",1,5))"
ActiveCell.Offset(0, -19).Formula = "=value(mid(" & ActiveCell.Offset(0,
-18).Address & ",7,4))"
ActiveCell.Offset(1, 0).Activate

Loop

data_end = ActiveCell.Offset(0, -19).Address
out_start = ActiveCell.Offset(3, -19).Address


' START sort data

Range("a5", Range(data_end).Offset(0, 19).Address).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Key2:=Range("B5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal

' END sort data

'START copy data to area for sumary output

Range("c5").Activate

Do Until ActiveCell.Value = ""
If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value Then


back = ActiveCell.Address
Range(ActiveCell.Address, ActiveCell.Offset(0, 1).Address).Copy

Range(out_start).Activate
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.PasteSpecial (xlPasteValues)


Range(back).Offset(1, 0).Activate

Else
ActiveCell.Offset(1, 0).Activate

End If

Loop

'END copy data to area for sumary output

'START creating sumif formulas in area for sumary output

For C = 1 To 15


Range(out_start).Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1 + C).Formula = "=SUMIF($C$5:" &
Range(data_end).Offset(0, 1).Address & "," & ActiveCell.Address & "," &
Range("c5").Offset(0, C + 1).Address & ":" & Range(data_end).Offset(0, C +
2).Address & ")"
ActiveCell.Offset(1, 0).Activate

Loop

Next C

Range(out_start).Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 18).Formula = "=" & ActiveCell.Address
ActiveCell.Offset(1, 0).Activate

Loop

out_end = ActiveCell.Offset(0, 18).Address

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub test2()
col = "H"

Range("A3").Formula = "=IF(COLUMN(" & col & "2)<=9,0,(sum(" &
ActiveCell.Offset(1, 5).Address & ":" & ActiveCell.Offset(1, 2 + x).Address &
"))*" & col & "6)*R_F"

End Sub

Saludos,
Paola


"Héctor Miguel" escribió:

hola, Paola !
Respuesta Responder a este mensaje
#3 Héctor Miguel
23/01/2009 - 02:14 | Informe spam
hola, Paola !

(definitivamente) tu codigo puede ser agilizado luego de una depuracion +/- "exhaustiva"
solo que son demasiadas lineas y en su mayoria bucles (casi-casi) "redundantes"
ademas (ya lo comentas) tiene un "exceso" de instrucciones "select", "activate" y "activecell"
y no por inhibir un refresco de la pantalla (Application.ScreenUpdating = False)
evitas que la aplicacion "se la pase saltando" (efectivamente celda por celda) en los bucles :-(

tratare de revisar estos codigos "en mis ratos de ocio" :))
(ojala alguien mas tenga mas tiempo y te ayude a resolverlo antes)

saludos,
hector.

__ OP __
Ahora con respecto a la lentitud tan considerada con macros en excel2007 a
comparacion de 2003. Te comento que las macros tienen instrucciones de tipo
ActiveCell, pero te adjunto codigo para que lo veas, gracias por tu apoyo:
Public acc_no As String
Public A_RN As String
Public AS_RN As String
Public mon As String
Public col As String
Public x As Single
Public col2 As String
Public i As Single
Public CO As String
Public acc_start1 As String
Public acc_start2 As String
Public acc_start3 As String
Public acc_end1 As String
Public acc_end2 As String
Public acc_end3 As String
Public model_name As String
Public input_name As String
Public out_start As String
Public out_end As String
Public ass_sheet As String
Public cal_sheet As String
Public company_col As String
Public ass_sheet_ref As String

Sub Formula_creator()

'Inhabilita el cambio o movimiento del cursor y pantallas durante el
desarrollo de la macro _
y el calculo automatico de excel. Ahorra memoria y tiempo.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Q = 1 To 17 'For Q = 1 To 17

A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
"a-mid", "a-mtt", "a-oax", _
"a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
"a-elim_cun")

C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
"c-mid", "c-mtt", "c-oax", _
"c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
"c-elim_cun")

C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s")

A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
"'a-czm'!", "'a-hux'!", "'a-mid'!", _
"'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
"'a-ras'!", "'a-gas'!", _
"'a-elim_asur'!", "'a-elim_cun'!")

ass_sheet = A_X 'Assumptions sheet
cal_sheet = C_X 'Calculation sheet
company_col = C_COL 'Company column
ass_sheet_ref = A_X2 'Assumption reference sheet

For x = 1 To 13 'For x = 1 To 13

mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
"jun", "jul", "aug", "sep", "oct", _
"nov", "dec")

col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
"r", "s", "t")

col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
"p", "q", "r")

Sheets(cal_sheet).Select
Range("D9").Activate 'Original Range("D9").Activate
Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate
Loop

Do Until ActiveCell.Value = "STOP"

If ActiveCell.Value = "" Then
Else
acc_no = ActiveCell.Value

find_actual_RN

find_assumption_RN

Sheets(cal_sheet).Select

'Proceso inhabilitado.
' If acc_no < 4000 Then
' ActiveCell.Offset(1, 0).Activate
' Else

If Selection.Interior.ColorIndex = 15 Then

ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col &
"$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" & company_col
& A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address _
& ":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0),IF(COLUMN(" _
& col & "$2)<=9,0,sum(" & ActiveCell.Offset(1,
5).Address & ":" & _
ActiveCell.Offset(1, 2 + x).Address & "))*" & col &
"6)*R_F"
Else
If ActiveCell.Offset(0, -1).Value = "C" Then

back = ActiveCell.Address

Sheets(cal_sheet).Select 'Selecciona la hoja de
cà¡lculo
Range("D800").Activate

Do While ActiveCell.Row < 1200
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
C_RN = ActiveCell.Row
'Calculation row number numero
de renglon.

Exit Do
Else
C_RN = 1500
End If
Loop

Range(back).Activate
'Regresa a la celda de la cuenta cuya columna c
tiene una "C"

If ActiveCell.Offset(0, -1).Interior.ColorIndex = 15
Then 'Si ademà¡s, tiene color _
gris, genera la siguiente fórmula
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
col & "$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" &
company_col & A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address & _
":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0)," & col & C_RN & ")*R_F"

Else
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
col & "$4" & "," & _
ActiveCell.Offset(0, -2).Value & mon & "!" &
company_col & A_RN & _
"-IF(COLUMN(" & col & "$2)>9,sum(" &
ActiveCell.Offset(0, 5).Address & _
":" & ActiveCell.Offset(0, 3 + x - 1).Address &
"),0)," & col & C_RN & ")"

End If

Else
ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col & "$4" &
"," & ActiveCell.Offset(0, -2).Value & _
mon & "!" & company_col & A_RN & "-IF(COLUMN(" & col &
"$2)>9,sum(" & ActiveCell.Offset(0, 5).Address & ":" & _
ActiveCell.Offset(0, 3 + x - 1).Address & "),0)," &
ass_sheet_ref & col & AS_RN & ")"

End If
End If
End If

ActiveCell.Offset(1, 0).Activate
acc_no = ActiveCell.Value
' End If
Loop

Next x

Next Q

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Formula_creator_assets

End Sub

Sub Formula_creator_assets()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'ass_sheet = "a-cun"
'cal_sheet = "c-cun"
'company_col = "c"
'ass_sheet_ref = "'a-cun'!"

For Q = 1 To 17 'For Q = 1 To 17

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
"a-mid", "a-mtt", "a-oax", _
"a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
"a-elim_cun")

C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
"c-mid", "c-mtt", "c-oax", _
"c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
"c-elim_cun")

C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
"n", "o", "p", "q", "r", "s")

A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
"'a-czm'!", "'a-hux'!", "'a-mid'!", _
"'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
"'a-ras'!", "'a-gas'!", _
"'a-elim_asur'!", "'a-elim_cun'!")

ass_sheet = A_X 'Assumptions sheet
cal_sheet = C_X 'Calculation sheet
company_col = C_COL 'Company column
ass_sheet_ref = A_X2 'Assumption reference sheet

For x = 1 To 13 'For x = 1 To 13

mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
"jun", "jul", "aug", "sep", "oct", _
"nov", "dec")

col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
"r", "s", "t")

col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
"p", "q", "r")

Sheets(cal_sheet).Select
Range("E413").Activate 'Original Range("E413").Activate

Do Until ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Activate
Loop
Do Until ActiveCell.Value = "STOP"
If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Activate
Else
acc_no = ActiveCell.Value
find_actual_RN
find_assumption_RN
Sheets(cal_sheet).Select
If ActiveCell.Offset(0, -2).Value = "DEP" Then
ActiveCell.Offset(0, 2 + x).Formula = "=choose("
& col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon & "!" &
company_col & A_RN & "," _
& ActiveCell.Offset(0, 1 + x).Address & "- " &
ass_sheet_ref & col & AS_RN & ")"
Else
If ActiveCell.Offset(0, -2).Value = "DEP_R"
Then
ActiveCell.Offset(0, 2 + x).Formula > "=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon &
"!" & company_col & A_RN & "," _
& ActiveCell.Offset(1, 1 + x).Address &
"*(1+" & col & "$6)- " & _
ass_sheet_ref & col & AS_RN & "-" &
ActiveCell.Offset(-1, 2 + x).Address & ")*R_F"
Else
If ActiveCell.Offset(0, -2).Value > "F" Then
ActiveCell.Offset(0, 2 + x).Formula
= "=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0, -3).Value & mon
& "!" & company_col & A_RN & "," & _
ActiveCell.Offset(0, 1 + x).Address
& ")"

Else
If ActiveCell.Offset(0,
-2).Value = "R" Then
ActiveCell.Offset(0, 2 +
x).Formula = "=choose(" & col & "$4" & "," & _
ActiveCell.Offset(0,
-3).Value & mon & "!" & company_col & A_RN & "," _
& ActiveCell.Offset(0, 1 +
x).Address & "+" & ActiveCell.Offset(1, 1 + _
x).Address & "*" & col &
"$6)*R_F"

Else
If
ActiveCell.Offset(0, -2).Value = "C" Then
back > ActiveCell.Address

Sheets(cal_sheet).Select

Range("D800").Activate
Do While
ActiveCell.Row < 1200

ActiveCell.Offset(1, 0).Activate
If
ActiveCell.Value = acc_no Then

C_RN = ActiveCell.Row
Exit
Do

Else

C_RN = 1500
End If
Loop

Range(back).Activate
If
ActiveCell.Offset(0, -2).Interior.ColorIndex _
= 15
Then

ActiveCell.Offset(0, 2 + x).Formula = _

"=choose(" & col & "$4" & "," & ActiveCell.Offset _

(0, -3).Value & mon & "!" & company_col & A_RN _

& "," & col & C_RN & ")*R_F"

Else

ActiveCell.Offset(0, 2 + x).Formula = _

"=choose(" & col & "$4" & "," & ActiveCell.Offset _

(0, -3).Value & mon & "!" & company_col & A_RN _

& "," & col & C_RN & ")"
End If
Else

ActiveCell.Offset(0, 2 + x).Formula = "=choose(" _

& col & "$4" & "," & ActiveCell.Offset(0, -3).Value & _

mon & "!" & company_col & A_RN & ",0)"

End If

End If

End If

End If

End If
ActiveCell.Offset(1, 0).Activate
acc_no = ActiveCell.Value
End If
Loop
Next x
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Next Q
Sheets("Manager").Select
Range("A1").Activate
End Sub

Sub find_actual_RN()

Choose(x, Sheet6, Sheet7, Sheet8, Sheet9, Sheet10, Sheet11, Sheet12,
Sheet13, Sheet14, Sheet15, Sheet16, _
Sheet17, Sheet18).Select
'Selecciona X como mes sheet6=Dec n-1, Sheet7=Jan y asi es por
la posicion de las _

Range("A10").Activate
Do While ActiveCell.Row < 700 'Ok 700 son suficientes
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
A_RN = ActiveCell.Row

Exit Do
Else
A_RN = 1500
End If
Loop
End Sub

Sub find_assumption_RN()
Sheets(ass_sheet).Select

Range("c1").Activate
Do While ActiveCell.Row < 550
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
AS_RN = ActiveCell.Row
'Assumption row number numero de renglon.
Exit Do
Else
AS_RN = 1500

End If
Loop
End Sub

Sub find_calculation_RN()

Sheets(cal_sheet).Select
Range("d727").Activate
Do While ActiveCell.Row < 1200
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = acc_no Then
C_RN = ActiveCell.Row
Exit Do
Else

C_RN = 1500

End If
Loop

End Sub
Sub Import_asset_values()

model_name = ActiveWorkbook.Name

Create_export_assets

inport_mon = Application.InputBox("enter month of inport", "Import of assets
values", , , , , , 2)

Workbooks(input_name).Worksheets("output").Activate

Range(Range(out_start).Offset(0, 1).Address, out_end).Copy

Workbooks(model_name).Worksheets(inport_mon).Activate

Range("b15").Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
Loop

ActiveCell.PasteSpecial (xlPasteValues)

End Sub
Sub Create_export_assets()

'START the opning detaild balance code

fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")

Response = MsgBox("open" & fileToOpen, vbYesNo, "Open")
If Response = vbYes Then ' User chose Yes.
Workbooks.Open (fileToOpen) ' Perform some action.

input_name = ActiveWorkbook.Name

'END the opning detaild balance code - IF opning

'START creating combinded account number

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets.Add.Name = "Output"

For i = 1 To 15

CO = Choose(i, "CUN", "CZM", "HUX", "MID", "MTT", "OAX", "TAP", "VER",
"VSA", "SAS", "GAS", "CARGA", "FBO", "98", "96")

Worksheets(CO).Activate

Range("a11").Activate

Do Until ActiveCell.Value = "Saldo Final"
ActiveCell.Offset(0, 1).Activate
Loop

ActiveCell.Offset(2, 1).Activate

Do Until ActiveCell.Offset(0, -1).Value = ""
ActiveCell.Formula = "=" & ActiveCell.Offset(0, -5).Address
ActiveCell.Offset(0, 1).Formula = "=" & ActiveCell.Offset(0, -1).Address
ActiveCell.Offset(0, 2).Formula = "= mid(" & ActiveCell.Offset(0,
-4).Address & ",4,28)"

ActiveCell.Offset(1, 0).Activate

Loop

Next i

Application.Calculation = xlCalculationAutomatic

'START copy the account structur form CUN

Worksheets("CUN").Activate

Find_assets_accounts

'START copy assets accounts form CUN

Range(acc_start1, acc_end1).Copy

Worksheets("Output").Activate
Range("d5").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Worksheets("CUN").Activate
Range(acc_start2, acc_end2).Copy

Worksheets("Output").Activate
Range("e5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Worksheets("CUN").Activate
Range(acc_start3, acc_end3).Copy

Worksheets("Output").Activate
Range("u5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'END copy assets accounts form CUN

Application.Calculation = xlCalculationManual

For i = 2 To 15

CO = Choose(i, "CUN", "CZM", "HUX", "MID", "MTT", "OAX", "TAP", "VER",
"VSA", "SAS", "GAS", "CARGA", "FBO", "98", "96")

Worksheets(CO).Activate
Range("a13").Activate

Do Until ActiveCell.Value > "1800"
ActiveCell.Offset(1, 0).Activate

Loop

Do Until ActiveCell.Value > "2000"
acc_n = ActiveCell.Offset(0, 6).Value
acc_v = ActiveCell.Offset(0, 7).Value
acc = ActiveCell.Offset(0, 8).Value
ActiveCell.Offset(1, 0).Activate

With Worksheets("output").Range("u5:u500")
Set C = .Find(acc, LookIn:=xlValues)
If Not C Is Nothing Then

C.Offset(0, -17 + i).Value = acc_v

Else

Worksheets("output").Activate

Range("d10").Activate

Do Until ActiveCell.Value = ""

ActiveCell.Offset(1, 0).Activate

Loop

ActiveCell.Value = acc_n
ActiveCell.Offset(0, 0 + i).Value = acc_v
ActiveCell.Offset(0, 17).Value = acc

End If
End With

Worksheets(CO).Activate

Loop

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

adjust_output_data
Else

End If

End Sub

Sub Find_assets_accounts()

'START Find the assets accounts

Range("a13").Activate

Do Until ActiveCell.Value > "1800"
ActiveCell.Offset(1, 0).Activate

Loop

acc_start1 = ActiveCell.Offset(0, 6).Address
acc_start2 = ActiveCell.Offset(0, 7).Address
acc_start3 = ActiveCell.Offset(0, 8).Address

Do Until ActiveCell.Value > "2000"
ActiveCell.Offset(1, 0).Activate

Loop
acc_end1 = ActiveCell.Offset(-1, 6).Address
acc_end2 = ActiveCell.Offset(-1, 7).Address
acc_end3 = ActiveCell.Offset(-1, 8).Address

'END Find the assets accounts

End Sub

Sub adjust_output_data()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets("output").Activate

Range("u5").Activate

Do Until ActiveCell.Value = ""

ActiveCell.Offset(0, -18).Formula = "=mid(" & ActiveCell.Address & ",6,10)"
ActiveCell.Offset(0, -20).Formula = "=value(mid(" & ActiveCell.Offset(0,
-18).Address & ",1,5))"
ActiveCell.Offset(0, -19).Formula = "=value(mid(" & ActiveCell.Offset(0,
-18).Address & ",7,4))"
ActiveCell.Offset(1, 0).Activate

Loop

data_end = ActiveCell.Offset(0, -19).Address
out_start = ActiveCell.Offset(3, -19).Address

' START sort data

Range("a5", Range(data_end).Offset(0, 19).Address).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Key2:=Range("B5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal

' END sort data

'START copy data to area for sumary output

Range("c5").Activate

Do Until ActiveCell.Value = ""
If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value Then

back = ActiveCell.Address
Range(ActiveCell.Address, ActiveCell.Offset(0, 1).Address).Copy

Range(out_start).Activate
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.PasteSpecial (xlPasteValues)

Range(back).Offset(1, 0).Activate

Else
ActiveCell.Offset(1, 0).Activate

End If

Loop

'END copy data to area for sumary output

'START creating sumif formulas in area for sumary output

For C = 1 To 15

Range(out_start).Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1 + C).Formula = "=SUMIF($C$5:" &
Range(data_end).Offset(0, 1).Address & "," & ActiveCell.Address & "," &
Range("c5").Offset(0, C + 1).Address & ":" & Range(data_end).Offset(0, C +
2).Address & ")"
ActiveCell.Offset(1, 0).Activate

Loop

Next C

Range(out_start).Activate

Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 18).Formula = "=" & ActiveCell.Address
ActiveCell.Offset(1, 0).Activate

Loop

out_end = ActiveCell.Offset(0, 18).Address

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub test2()
col = "H"

Range("A3").Formula = "=IF(COLUMN(" & col & "2)<=9,0,(sum(" &
ActiveCell.Offset(1, 5).Address & ":" & ActiveCell.Offset(1, 2 + x).Address &
"))*" & col & "6)*R_F"

End Sub

Saludos,
Paola
Respuesta Responder a este mensaje
#4 Paola
23/01/2009 - 17:11 | Informe spam
Gracias por la respuesta,
vamos a revisar el código pero eso si , definitivamente no somos
programadores.
Pero lo que me llama la atención es que exactamente el mismo código
corriendolo en excel 2003 tarda mucho menos que en 2007, imagino que algo
debe de existir para eficientarlo.

Gracias.

"Héctor Miguel" escribió:

hola, Paola !

(definitivamente) tu codigo puede ser agilizado luego de una depuracion +/- "exhaustiva"
solo que son demasiadas lineas y en su mayoria bucles (casi-casi) "redundantes"
ademas (ya lo comentas) tiene un "exceso" de instrucciones "select", "activate" y "activecell"
y no por inhibir un refresco de la pantalla (Application.ScreenUpdating = False)
evitas que la aplicacion "se la pase saltando" (efectivamente celda por celda) en los bucles :-(

tratare de revisar estos codigos "en mis ratos de ocio" :))
(ojala alguien mas tenga mas tiempo y te ayude a resolverlo antes)

saludos,
hector.

__ OP __
> Ahora con respecto a la lentitud tan considerada con macros en excel2007 a
> comparacion de 2003. Te comento que las macros tienen instrucciones de tipo
> ActiveCell, pero te adjunto codigo para que lo veas, gracias por tu apoyo:
> Public acc_no As String
> Public A_RN As String
> Public AS_RN As String
> Public mon As String
> Public col As String
> Public x As Single
> Public col2 As String
> Public i As Single
> Public CO As String
> Public acc_start1 As String
> Public acc_start2 As String
> Public acc_start3 As String
> Public acc_end1 As String
> Public acc_end2 As String
> Public acc_end3 As String
> Public model_name As String
> Public input_name As String
> Public out_start As String
> Public out_end As String
> Public ass_sheet As String
> Public cal_sheet As String
> Public company_col As String
> Public ass_sheet_ref As String
>
> Sub Formula_creator()
>
> 'Inhabilita el cambio o movimiento del cursor y pantallas durante el
> desarrollo de la macro _
> y el calculo automatico de excel. Ahorra memoria y tiempo.
> Application.ScreenUpdating = False
> Application.Calculation = xlCalculationManual
>
> For Q = 1 To 17 'For Q = 1 To 17
>
> A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
> "a-mid", "a-mtt", "a-oax", _
> "a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
> "a-elim_cun")
>
> C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
> "c-mid", "c-mtt", "c-oax", _
> "c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
> "c-elim_cun")
>
> C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
> "n", "o", "p", "q", "r", "s")
>
> A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
> "'a-czm'!", "'a-hux'!", "'a-mid'!", _
> "'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
> "'a-ras'!", "'a-gas'!", _
> "'a-elim_asur'!", "'a-elim_cun'!")
>
> ass_sheet = A_X 'Assumptions sheet
> cal_sheet = C_X 'Calculation sheet
> company_col = C_COL 'Company column
> ass_sheet_ref = A_X2 'Assumption reference sheet
>
> For x = 1 To 13 'For x = 1 To 13
>
> mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
> "jun", "jul", "aug", "sep", "oct", _
> "nov", "dec")
>
> col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
> "r", "s", "t")
>
> col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
> "p", "q", "r")
>
> Sheets(cal_sheet).Select
> Range("D9").Activate 'Original Range("D9").Activate
> Do Until ActiveCell.Value <> ""
> ActiveCell.Offset(1, 0).Activate
> Loop
>
> Do Until ActiveCell.Value = "STOP"
>
> If ActiveCell.Value = "" Then
> Else
> acc_no = ActiveCell.Value
>
> find_actual_RN
>
> find_assumption_RN
>
> Sheets(cal_sheet).Select
>
> 'Proceso inhabilitado.
> ' If acc_no < 4000 Then
> ' ActiveCell.Offset(1, 0).Activate
> ' Else
>
> If Selection.Interior.ColorIndex = 15 Then
>
> ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col &
> "$4" & "," & _
> ActiveCell.Offset(0, -2).Value & mon & "!" & company_col
> & A_RN & _
> "-IF(COLUMN(" & col & "$2)>9,sum(" &
> ActiveCell.Offset(0, 5).Address _
> & ":" & ActiveCell.Offset(0, 3 + x - 1).Address &
> "),0),IF(COLUMN(" _
> & col & "$2)<=9,0,sum(" & ActiveCell.Offset(1,
> 5).Address & ":" & _
> ActiveCell.Offset(1, 2 + x).Address & "))*" & col &
> "6)*R_F"
> Else
> If ActiveCell.Offset(0, -1).Value = "C" Then
>
> back = ActiveCell.Address
>
> Sheets(cal_sheet).Select 'Selecciona la hoja de
> cà¡lculo
> Range("D800").Activate
>
> Do While ActiveCell.Row < 1200
> ActiveCell.Offset(1, 0).Activate
> If ActiveCell.Value = acc_no Then
> C_RN = ActiveCell.Row
> 'Calculation row number numero
> de renglon.
>
> Exit Do
> Else
> C_RN = 1500
> End If
> Loop
>
> Range(back).Activate
> 'Regresa a la celda de la cuenta cuya columna c
> tiene una "C"
>
> If ActiveCell.Offset(0, -1).Interior.ColorIndex = 15
> Then 'Si ademà¡s, tiene color _
> gris, genera la siguiente fórmula
> ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
> col & "$4" & "," & _
> ActiveCell.Offset(0, -2).Value & mon & "!" &
> company_col & A_RN & _
> "-IF(COLUMN(" & col & "$2)>9,sum(" &
> ActiveCell.Offset(0, 5).Address & _
> ":" & ActiveCell.Offset(0, 3 + x - 1).Address &
> "),0)," & col & C_RN & ")*R_F"
>
> Else
> ActiveCell.Offset(0, 3 + x).Formula = "=choose(" &
> col & "$4" & "," & _
> ActiveCell.Offset(0, -2).Value & mon & "!" &
> company_col & A_RN & _
> "-IF(COLUMN(" & col & "$2)>9,sum(" &
> ActiveCell.Offset(0, 5).Address & _
> ":" & ActiveCell.Offset(0, 3 + x - 1).Address &
> "),0)," & col & C_RN & ")"
>
> End If
>
> Else
> ActiveCell.Offset(0, 3 + x).Formula = "=choose(" & col & "$4" &
> "," & ActiveCell.Offset(0, -2).Value & _
> mon & "!" & company_col & A_RN & "-IF(COLUMN(" & col &
> "$2)>9,sum(" & ActiveCell.Offset(0, 5).Address & ":" & _
> ActiveCell.Offset(0, 3 + x - 1).Address & "),0)," &
> ass_sheet_ref & col & AS_RN & ")"
>
> End If
> End If
> End If
>
> ActiveCell.Offset(1, 0).Activate
> acc_no = ActiveCell.Value
> ' End If
> Loop
>
> Next x
>
> Next Q
>
> Application.Calculation = xlCalculationAutomatic
> Application.ScreenUpdating = True
>
> Formula_creator_assets
>
> End Sub
>
> Sub Formula_creator_assets()
>
> Application.ScreenUpdating = False
> Application.Calculation = xlCalculationManual
>
> 'ass_sheet = "a-cun"
> 'cal_sheet = "c-cun"
> 'company_col = "c"
> 'ass_sheet_ref = "'a-cun'!"
>
> For Q = 1 To 17 'For Q = 1 To 17
>
> Application.ScreenUpdating = False
> Application.Calculation = xlCalculationManual
>
> A_X = Choose(Q, "a-cun", "a-car", "a-cas", "a-fbo", "a-czm", "a-hux",
> "a-mid", "a-mtt", "a-oax", _
> "a-tap", "a-ver", "a-vsa", "a-sas", "a-ras", "a-gas", "a-elim_ASUR",
> "a-elim_cun")
>
> C_X = Choose(Q, "c-cun", "c-car", "c-cas", "c-fbo", "c-czm", "c-hux",
> "c-mid", "c-mtt", "c-oax", _
> "c-tap", "c-ver", "c-vsa", "c-sas", "c-ras", "c-gas", "c-elim_ASUR",
> "c-elim_cun")
>
> C_COL = Choose(Q, "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
> "n", "o", "p", "q", "r", "s")
>
> A_X2 = Choose(Q, "'a-cun'!", "'a-car'!", "'a-cas'!", "'a-fbo'!",
> "'a-czm'!", "'a-hux'!", "'a-mid'!", _
> "'a-mtt'!", "'a-oax'!", "'a-tap'!", "'a-ver'!", "'a-vsa'!", "'a-sas'!",
> "'a-ras'!", "'a-gas'!", _
> "'a-elim_asur'!", "'a-elim_cun'!")
>
> ass_sheet = A_X 'Assumptions sheet
> cal_sheet = C_X 'Calculation sheet
> company_col = C_COL 'Company column
> ass_sheet_ref = A_X2 'Assumption reference sheet
>
> For x = 1 To 13 'For x = 1 To 13
>
> mon = Choose(x, "'dec n-1'", "jan", "feb", "mar", "apr", "may",
> "jun", "jul", "aug", "sep", "oct", _
> "nov", "dec")
>
> col = Choose(x, "h", "i", "j", "k", "l", "m", "n", "o", "p", "q",
> "r", "s", "t")
>
> col2 = Choose(x, "e", "g", "h", "i", "j", "k", "l", "m", "n", "o",
> "p", "q", "r")
>
> Sheets(cal_sheet).Select
> Range("E413").Activate 'Original Range("E413").Activate
>
> Do Until ActiveCell.Value <> ""
> ActiveCell.Offset(1, 0).Activate
> Loop
> Do Until ActiveCell.Value = "STOP"
> If ActiveCell.Value = "" Then
> ActiveCell.Offset(1, 0).Activate
> Else
> acc_no = ActiveCell.Value
> find_actual_RN
> find_assumption_RN
> Sheets(cal_sheet).Select
> If ActiveCell.Offset(0, -2).Value = "DEP" Then
> ActiveCell.Offset(0, 2 + x).Formula = "=choose("
> & col & "$4" & "," & _
> ActiveCell.Offset(0, -3).Value & mon & "!" &
> company_col & A_RN & "," _
> & ActiveCell.Offset(0, 1 + x).Address & "- " &
> ass_sheet_ref & col & AS_RN & ")"
> Else
> If ActiveCell.Offset(0, -2).Value = "DEP_R"
> Then
> ActiveCell.Offset(0, 2 + x).Formula > > "=choose(" & col & "$4" & "," & _
> ActiveCell.Offset(0, -3).Value & mon &
> "!" & company_col & A_RN & "," _
> & ActiveCell.Offset(1, 1 + x).Address &
> "*(1+" & col & "$6)- " & _
> ass_sheet_ref & col & AS_RN & "-" &
> ActiveCell.Offset(-1, 2 + x).Address & ")*R_F"
> Else
> If ActiveCell.Offset(0, -2).Value > > "F" Then
> ActiveCell.Offset(0, 2 + x).Formula
> = "=choose(" & col & "$4" & "," & _
> ActiveCell.Offset(0, -3).Value & mon
> & "!" & company_col & A_RN & "," & _
> ActiveCell.Offset(0, 1 + x).Address
> & ")"
>
> Else
> If ActiveCell.Offset(0,
> -2).Value = "R" Then
> ActiveCell.Offset(0, 2 +
Respuesta Responder a este mensaje
#5 Edgar
23/01/2009 - 17:50 | Informe spam
Excel 2007 consume mas recursos, por lo que, por decir de un modo,
deja con menos recursos a la macro

Edgar
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida