CAMBIAR CÓDIGO PARA ACELERAR MACRO.

19/12/2006 - 10:43 por MarianoB | Informe spam
Hola grupo,

Tengo unos datos que importo desde un query de AS400, todas las
columnas tienen igual
longitud. Algunas filas estan "repetidas" excepto una columna (la
última).
Lo que he hecho es trasponer (con codigo porque son unos 13000
registros) esos datos ,que varían, a la primera fila repetida de cada
"repetición" (hay filas que no se repiten y otras que si lo hacen en
algunos casos hasta 8 veces). Posteriormente he marcado en una nueva
columna en el lado derecho cuantas celdas he traspuesto y finalmente en
función de ese numero (número de filas por debajo de la actual que
sobran y, por lo tanto, borro) borro las filas siguientes (si pone un 2
borro las 2 siguientes, si pone un 5 borro las 5 siguientes, si pone un
0 no borro la siguiente).
La parte de una pequeña formula matricial que varía solo un poco
(está aplicada en 10 columnas) y que he copiado luego a unas 13000
filas y tarda aproximadamente un minuto en ejecutarse es la parte del
codigo que me gustaría "acelerar" (el tiempo dependerá del equipo de
cada uno) ya que es como indico es muy
lento.

Sub a()
'
'a Macro
' Macro grabada el 19/12/2006 por MarianoB
'
' Acceso directo: CTRL+a
'LA PARTE LENTA EMPIEZA AQUÍ Y LLEGA HASTA LOS ASTERISCOS

Range("Y2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-23]=R[1]C[-23],R[1]C[-1]<>RC[-1]:RC[-1],R[-1]C[-23]<>""""),R[1]C[-1],"""")"
Range("Z2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-24]=R[2]C[-24],R[2]C[-2]<>RC[-2]:RC[-1],R[-1]C[-24]<>""""),R[2]C[-2],"""")"
Range("AA2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-25]=R[3]C[-25],R[3]C[-3]<>RC[-3]:RC[-1],R[-1]C[-25]<>""""),R[3]C[-3],"""")"
Range("AB2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-26]=R[4]C[-26],R[4]C[-4]<>RC[-4]:RC[-1],R[-1]C[-26]<>""""),R[4]C[-4],"""")"
Range("AC2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-27]=R[5]C[-27],R[5]C[-5]<>RC[-5]:RC[-1],R[-1]C[-27]<>""""),R[5]C[-5],"""")"
Range("AD2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-28]=R[6]C[-28],R[6]C[-6]<>RC[-6]:RC[-1],R[-1]C[-28]<>""""),R[6]C[-6],"""")"
Range("AE2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-29]=R[7]C[-29],R[7]C[-7]<>RC[-7]:RC[-1],R[-1]C[-29]<>""""),R[7]C[-7],"""")"
Range("AF2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-30]=R[8]C[-30],R[8]C[-8]<>RC[-8]:RC[-1],R[-1]C[-30]<>""""),R[8]C[-8],"""")"
Range("AG2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-31]=R[9]C[-31],R[9]C[-9]<>RC[-9]:RC[-1],R[-1]C[-31]<>""""),R[9]C[-9],"""")"
Range("AH2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-32]=R[10]C[-32],R[10]C[-10]<>RC[-10]:RC[-1],R[-1]C[-32]<>""""),R[10]C[-10],"""")"
' CUENTA LAS VECES QUE SE REPITE Y COPIA TODO HACIA ABAJO
Range("ai2").Select
ActiveCell.FormulaR1C1 = "-COUNTBLANK(RC[-10]:RC[-1])"
Range("AI2").Select
Range("Y2:ai2").Select
Selection.Copy
Range("Y3:ai13000").Select
ActiveSheet.Paste
'*********************
Columns("Y:AI").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'ESTÁ PARTE ES UNA APORTACIÓN DE IVAN DE
groups.google.com/group/microsoft.public.es.excel
Dim f As Long
For f = 2 To [ai65536].End(xlUp).Row
With Range("ai" & f)
If .Value > 0 Then
Select Case .Value
Case 1: .Offset(1, 0).EntireRow.Delete
Case Else
Range("ai" & f + 1 & ":ai" & f +
.Value).EntireRow.Delete
End Select
' .Value = 0
.Value = 0
End If
End With
Next
End Sub


SALU2 a tod@s.

MarianoB

Preguntas similare

Leer las respuestas

#1 Juan M
19/12/2006 - 12:05 | Informe spam
Hola Mariano

Si el problema esta en el calculo de las formulas matriciales,
sencillamente, no las hagas.

Me explico, si sabes que es lo que estas haciendo con las formulas, no
conociendo los datos me es dificil, prueba a hacerlo por codigo todos los
calculos, ya que despues de todo el lio copias y pegas solo los valores.

Ademas, las formulas matriciales son lentas, si ya metes 13000 filas y lo
multiplicas por 10, bueno es lo que resulta.

Otra opcion es ajustar el calculo a manual mientras insertas las formulas y
cuando termines las formulas lo vuelves a activar.

Podrias comentarnos que hacen las formulas matriciales que has planteado?
Sin ver los datos creo que buscas coincidencias con algo y dependiendo del
caso colocas un valor.

Ya nos contaras los resultados.

Un saludo
Juan

Consulta Original
"MarianoB" escribió en el mensaje
news:
Hola grupo,

Tengo unos datos que importo desde un query de AS400, todas las
columnas tienen igual
longitud. Algunas filas estan "repetidas" excepto una columna (la
última).
Lo que he hecho es trasponer (con codigo porque son unos 13000
registros) esos datos ,que varían, a la primera fila repetida de cada
"repetición" (hay filas que no se repiten y otras que si lo hacen en
algunos casos hasta 8 veces). Posteriormente he marcado en una nueva
columna en el lado derecho cuantas celdas he traspuesto y finalmente en
función de ese numero (número de filas por debajo de la actual que
sobran y, por lo tanto, borro) borro las filas siguientes (si pone un 2
borro las 2 siguientes, si pone un 5 borro las 5 siguientes, si pone un
0 no borro la siguiente).
La parte de una pequeña formula matricial que varía solo un poco
(está aplicada en 10 columnas) y que he copiado luego a unas 13000
filas y tarda aproximadamente un minuto en ejecutarse es la parte del
codigo que me gustaría "acelerar" (el tiempo dependerá del equipo de
cada uno) ya que es como indico es muy
lento.

Sub a()
'
'a Macro
' Macro grabada el 19/12/2006 por MarianoB
'
' Acceso directo: CTRL+a
'LA PARTE LENTA EMPIEZA AQUÍ Y LLEGA HASTA LOS ASTERISCOS

Range("Y2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-23]=R[1]C[-23],R[1]C[-1]<>RC[-1]:RC[-1],R[-1]C[-23]<>""""),R[1]C[-1],"""")"
Range("Z2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-24]=R[2]C[-24],R[2]C[-2]<>RC[-2]:RC[-1],R[-1]C[-24]<>""""),R[2]C[-2],"""")"
Range("AA2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-25]=R[3]C[-25],R[3]C[-3]<>RC[-3]:RC[-1],R[-1]C[-25]<>""""),R[3]C[-3],"""")"
Range("AB2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-26]=R[4]C[-26],R[4]C[-4]<>RC[-4]:RC[-1],R[-1]C[-26]<>""""),R[4]C[-4],"""")"
Range("AC2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-27]=R[5]C[-27],R[5]C[-5]<>RC[-5]:RC[-1],R[-1]C[-27]<>""""),R[5]C[-5],"""")"
Range("AD2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-28]=R[6]C[-28],R[6]C[-6]<>RC[-6]:RC[-1],R[-1]C[-28]<>""""),R[6]C[-6],"""")"
Range("AE2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-29]=R[7]C[-29],R[7]C[-7]<>RC[-7]:RC[-1],R[-1]C[-29]<>""""),R[7]C[-7],"""")"
Range("AF2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-30]=R[8]C[-30],R[8]C[-8]<>RC[-8]:RC[-1],R[-1]C[-30]<>""""),R[8]C[-8],"""")"
Range("AG2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-31]=R[9]C[-31],R[9]C[-9]<>RC[-9]:RC[-1],R[-1]C[-31]<>""""),R[9]C[-9],"""")"
Range("AH2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-32]=R[10]C[-32],R[10]C[-10]<>RC[-10]:RC[-1],R[-1]C[-32]<>""""),R[10]C[-10],"""")"
' CUENTA LAS VECES QUE SE REPITE Y COPIA TODO HACIA ABAJO
Range("ai2").Select
ActiveCell.FormulaR1C1 = "-COUNTBLANK(RC[-10]:RC[-1])"
Range("AI2").Select
Range("Y2:ai2").Select
Selection.Copy
Range("Y3:ai13000").Select
ActiveSheet.Paste
'*********************
Columns("Y:AI").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'ESTÁ PARTE ES UNA APORTACIÓN DE IVAN DE
groups.google.com/group/microsoft.public.es.excel
Dim f As Long
For f = 2 To [ai65536].End(xlUp).Row
With Range("ai" & f)
If .Value > 0 Then
Select Case .Value
Case 1: .Offset(1, 0).EntireRow.Delete
Case Else
Range("ai" & f + 1 & ":ai" & f +
.Value).EntireRow.Delete
End Select
' .Value = 0
.Value = 0
End If
End With
Next
End Sub


SALU2 a

MarianoB
Respuesta Responder a este mensaje
#2 MarianoB
19/12/2006 - 19:00 | Informe spam
Hola Juan M

1. Estoy probando a pasar a código una de las fórmulas matriciales y
luego mediante un bucle que se repita n veces pero me estoy liando, o
estoy poniendo mal la sintaxis, o yo que se que me pasa (creo que la
longitud del codigo me ha "acongojado" y ya no doy pie con bola), pero
el caso es que no consigo pasarla a código:

Desde esta formula:

Range("Y2").Select
Selection.FormulaArray = _

"=IF(AND(RC[-23]=R[1]C[-23],R[1]C[-1]<>RC[-1]:RC[-1],R[-1]C[-23]<>""""),R[1]C[-1],"""")"


estoy llegando a esta otra que no funciona:


Range("y2").Select
Dim k As Long
For k = 2 To [y65536].End(xlUp).Row
With Range("y" & k)
If Range("y" & k, "y" & k - 23) = Range("y" & k + 1, "y" & k - 23)
And Range("y" & k + 1, "y" & k - 1) <> Range("y" & k, "y" & k - 1) And
Range("y" & k - 1, "y" & k - 23) <> "" Then
Range("y" & k, "y" & k) = Range("y" & k + 1, "y" & k - 1)
Select Case .Range("y" & k, "y" & k - 23) = Range("y" & k +
1, "y" & k - 23) And Range("y" & k + 1, "y" & k - 1) <> Range("y" & k,
"y" & k - 1) And Range("y" & k - 1, "y" & k - 23) <> """"
Case 1: .Range("y" & k, "y" & k) = Range("y" & k + 1, "y" &
k - 1)
Case Else
Range(0, 0) = """"
End Select
End If
End With
Next


2. La fórmula matricial comprueba tres cosas:
Que una celda que hay x columnas a la izquierda es
igual a una que hay x columnas a la izquierda y una mas abajo,
Que la celda que tiene a su izquierda o celdas (ya
que la formula se hacía en 10 columnas y la primera solo chequea una
celda a su izq., la segunda las 2 celdas de su izq. la tercera, 3 a su
izquierda, etc...) no tienen el mismo valor que el resultado de la
formula. [para esta parte uso la formula matricial]
Que la celda una fila por encima y x columnas a la
izquierda no están vacías.


Los datos.¿si te aburres y tienes algún sitio donde enviarte
el fichero?

SALU2

MarianoB




Juan M ha escrito:

Hola Mariano

Si el problema esta en el calculo de las formulas matriciales,
sencillamente, no las hagas.

Me explico, si sabes que es lo que estas haciendo con las formulas, no
conociendo los datos me es dificil, prueba a hacerlo por codigo todos los
calculos, ya que despues de todo el lio copias y pegas solo los valores.

Ademas, las formulas matriciales son lentas, si ya metes 13000 filas y lo
multiplicas por 10, bueno es lo que resulta.

Otra opcion es ajustar el calculo a manual mientras insertas las formulas y
cuando termines las formulas lo vuelves a activar.

Podrias comentarnos que hacen las formulas matriciales que has planteado?
Sin ver los datos creo que buscas coincidencias con algo y dependiendo del
caso colocas un valor.

Ya nos contaras los resultados.

Un saludo
Juan

Respuesta Responder a este mensaje
#3 Juan M
19/12/2006 - 19:29 | Informe spam
Hola Mariano

Enviame el archivo a la direccion que aparece quitando el NOSPAM

Por cierto, probaste poniendo el calculo en manual y luego de escritas las
formulas a automatico?
Application.Calculation = xlCalculationManual

Segun lo que comentas una vez que no cumple alguna condicion se puede evitar
seguir verdad?

Bueno espero el archivo

Un saludo
Juan
Respuesta Responder a este mensaje
#4 MarianoB
20/12/2006 - 15:58 | Informe spam
Hola Juan M,

he probado a poner el calculo en manual y luego de escritas las
formulas, a automático pero sigue lenta.
la mejor solucción creo que era la que me indicabas de poner por
código lo que hace la fórmula. me pondré con ello y ya te diré

SALU2.

MarianoB
Respuesta Responder a este mensaje
#5 MarianoB
20/12/2006 - 16:01 | Informe spam
Hola Juan M,

Segun lo que comentas una vez que no cumple alguna condicion se puede evitar
seguir verdad?



Cuando no cumple una condición no escribe nada pero continúa
chequeando la siguiente celda.

SALU2.

MarianoB
Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaSiguiente Respuesta Tengo una respuesta
Search Busqueda sugerida