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
 

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

Preguntas similares