¿Se puede mejorar un código en Excel?

El siguiente código se pone realmente muy lento cuando aumentan las filas de las hojas que lee

¿Alguien podría colaborar con una versión mejorada que sea más rápida?

Desde ya muchas gracias!

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If Sheets("HOJA1").AutoFilterMode = True Then Sheets("HOJA1").AutoFilterMode = False
    Columns("A:O").Select
    ActiveWorkbook.Worksheets("HOJA1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("HOJA1").Sort.SortFields.Add Key:=Range("B2:B936") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("HOJA1").Sort
        .SetRange Range("A1:O936")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Range("A2").Select
'ACTUALIZA FECHAS DE HOJA2 y HOJA3----------------------------------------------------------
Dim ultempresa, x, ultimaE, Y, W
ultempresa = Sheets("HOJA1").Range("C" & Rows.Count).End(xlUp).Row
ultimaE = Sheets("HOJA2").Range("C" & Rows.Count).End(xlUp).Row
ultimaC = Sheets("HOJA3").Range("C" & Rows.Count).End(xlUp).Row
For x = 2 To ultempresa
    If Sheets("HOJA1").Range("O" & x).Value = "1100" Then
       '---------------------------------------------------------------------------------------------------------
       For Y = 3 To ultimaE
          If Sheets("HOJA1").Range("C" & x).Value = Sheets("HOJA2").Range("K" & Y).Value Then
             Sheets("HOJA2").Range("J" & Y).Value = Sheets("HOJA1").Range("B" & x).Value
          End If
       Next Y
    End If
Next x
For x = 2 To ultimaE
    If Sheets("HOJA1").Range("O" & x).Value = "1200" Then
       '---------------------------------------------------------------------------------------------------------
       For W = 3 To ultimaC
          If Sheets("HOJA1").Range("C" & x).Value = Sheets("HOJA3").Range("K" & W).Value Then
             Sheets("HOJA3").Range("J" & W).Value = Sheets("HOJA1").Range("B" & x).Value
          End If
       Next W
    End If
Next x
Application.ScreenUpdating = True
End Sub

1 Respuesta

Respuesta
2

Tienes fórmulas en las hoja 1.

Tienes fórmulas en las hojas 2 y 3 en la columna J.

Existen datos en las hojas 2 y 3 en la columna J o están vacías las celdas.

Cuántos registros actualmente tienes en cada hoja.

Cuánto tiempo dura el proceso actual.

Gracias Dante

En la Hoja1 hay fórmulas muy básicas excepto una que es BUSCARV en otra hoja

En la hoja2 col J hay una fórmula del tipo BUSCARV; TIENE DATOS NUMÉRICOS

En la hoja3 col J hay una fórmula del tipo BUSCARV; TIENE DATOS NUMÉRICOS

Hoja1 ==> 83 filas con datos y creciendo

Hoja 2 ==> 1200 y creciendo

Hoja 2 aun no tiene datos pero no llega a más de 300 filas

Según tu macro, los resultados van en las hojas 2 y 3 en la columna J. Pero si dices que en la columna J tienes fórmulas, ¿entonces la macro sobreescribe la fórmula?

Y si las condiciones no se cumplen, ¿entonces la fórmula debe permanecer?

¿Cuánto tiempo tarda tu proceso actual?

Pido disculpas. La columna J no tiene fórmulas!

Lo que hace este código es ordenar por fechas las hojas 2 y 3 según como están las fechas en la hoja 1. Confundí por error involuntario la columna J con la L que si tiene una fórmula

Se que te vas a calentar por este yerro pero créeme fue involuntario

Disculpas.

Según tu macro ordenas la hoja1 por la columna B.

Pero luego comentas que ordenas las hojas 2 y 3. Es confuso para mi. Puedes explicarlo con ejemplos.

Por tercera vez: ¿Cuánto tiempo tarda tu proceso actual?

El proceso tarda 1 munito con 20 segundos

armare un ejemplo

Dante

envié a tu correo privado el ejemplo

saludos y muchas gracias

Puedes poner aquí un ejemplo de lo que tienes y el resultado esperado.

Si es posible envía un ejemplo donde yo pueda ver las hojas 1, 2 y 3 antes de la macro y en otras hojas, por decir, hoja1b, hoja2b y hoja3b, para que yo pueda apreciar los resultados.

¡Gracias!

Creo que estoy haciendo perder tu tiempo.

Tratare de resolverlo Yo

Envíe un ejemplo a tu correo pero no alcanzo, evidentemente.

Saludos, que estés bien

DC

Antes de resolver el problema debo analizar y entederlo por completo, si no lo entiendo, mi respuesta no sería la adecuada.

No te pedí enviar el ejemplo a mi correo. Debes poner aquí tus ejemplos, de esa manera, otros expertos también pueden aportar alguna solución.

¡Gracias!

Tema resuelto

Antepuse al código unas sentencias de calculo manual, etc etc y el proceso completo tarda 6 segundos: "lo resolví y funciona".

Saludos.

Te anexo el código para hacer las comparaciones en memoria.

La ejecución es inmediata.

Private Sub CommandButton1_Click()
'ACTUALIZA FECHAS DE HOJA2 y HOJA3----------------------------------------------------------
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, h1 As Worksheet, h2 As Worksheet, h3 As Worksheet
  Dim i As Long, j As Long, k As Long
  Set h1 = Sheets("Hoja1")
  Set h2 = Sheets("Hoja2")
  Set h3 = Sheets("Hoja3")
  '
  'CARGA DATOS DE LA HOJA1
  If h1.AutoFilterMode Then h1.AutoFilterMode = False
  a = h1.Range("A2:O" & h1.Range("C" & Rows.Count).End(3).Row).Value2
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    dic(a(i, 3) & "|" & a(i, 15)) = a(i, 2)
  Next
  '
  'PONE DATOS EN HOJA2
  b = h2.Range("K3", h2.Range("K" & Rows.Count).End(3)).Value2
  ReDim c(1 To UBound(b), 1 To 1)
  For i = 1 To UBound(b)
    c(i, 1) = dic(b(i, 1) & "|" & "1100")
  Next i
  h2.Range("J3").Resize(UBound(c)).Value = c
  '
  'PONE DATOS EN HOJA3
  Erase b
  b = h2.Range("K3", h2.Range("K" & Rows.Count).End(3)).Value2
  ReDim c(1 To UBound(b), 1 To 1)
  For i = 1 To UBound(b)
    c(i, 1) = dic(b(i, 1) & "|" & "1200")
  Next i
  h3.Range("J3").Resize(UBound(c)).Value = c
  '
  MsgBox "Fin"
End Sub

¡Gracias Dante, EXCELENTE!

El envío de tu análisis funciono perfecto y actualizo en milésimas de segundos!

es un trabajo excelente y desde ya lo agradezco mucho!

Un fuerte abrazo

DC

MI VALORACIÓN SIGUE SIENDO EXCELENTE

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas