CAMBIAR CÓDIGO PARA ACELERAR MACRO.

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