Optimizar macro vba

[flazaroc]

Hola compañeros, soy algo nuevo en el tema de macros... he podido realizar una macro (con ayuda del foro) pero tengo el problema que mientras mayor cantidad de datos el calculo demora demasiado hasta el punto de colgarse la aplicación...

La función de la macro es que en la columna M me indique con una X los registros mas recientes, esto luego de comparar las columnas K, E y F.

por ejemplo el Folio (columna K) N° 36078-S0801002537 tiene 4 registros, se marca con X la fila con fecha mas reciente (columna E), en el ejemplo existen 2 días iguales (columna E) , en ese caso se verifica por la hora (columna F) por lo tanto luego del analisis marca con una X (columna M) la fila A ya que es la última registrada.

Function MAXCONDICIONAL(RANGO1 As Range, COND1, RANGO2 As Range) As Double

    MAXIMO = 0

    For i = 1 To WorksheetFunction.CountA(RANGO1)

        VALOR = RANGO2(i).Value

        If RANGO1(i) = COND1 And VALOR > MAXIMO Then

            MAXIMO = RANGO2(i)

        End If

    Next

    If MAXIMO <= 0 Then MAXIMO = 0

    MAXCONDICIONAL = MAXIMO

End Function




Private Function CRC16(ByVal crc As Integer, d As Byte) As Integer

  Dim carry As Integer, i As Byte

  For i = 0 To 7

    carry = (crc And 1) Xor IIf(d And (2 ^ i), 1, 0)

    crc = (crc And &HFFFF&) \ 2

    If carry <> 0 Then crc = crc Xor &H8408

  Next i

  CRC16 = crc

End Function

Public Function CalcCrc16R(ByVal buf As String) As String

  Dim crc As Integer, t As Integer

  crc = &H8408

  For t = 1 To Len(buf)

    crc = CRC16(crc, Asc(Mid$(buf, t, 1)))

  Next t

  CalcCrc16R = Right(Right("0000" & Hex$(crc), 4), 2) & Left(Right("0000" & Hex$(crc), 4), 2)

End Function




Sub MacroFernando()

    ActiveCell.FormulaR1C1 = _

        "=+IF(CONCATENATE(RC[-16],(MAXCONDICIONAL(C[-16],RC[-16],C[-1])),(MAXCONDICIONAL(C[-16],RC[-16],C[-26])))=(CONCATENATE(RC[-16],VALUE(RC[-27]),RC[-26])),""x"","""")"

End Sub


[/CODE]

Adjunto la macro como ejemplo y me puedan ayudar.

Desde ya agradezco su ayuda :encouragement::encouragement::encouragement:

Saludos,

Fernando.

validacion_registros_optimizar.rar

[bigpetroman]

amigo flazaroc, te anexo 2 posibles soluciones, una es con una formula matricial que hace el cálculo mucho mas rápido que tu archivo, y la otra es con la misma forma que tienes actualmente pero la formula se activa solamente para la fila que está siendo modificada, se hace el cálculo y se copia el valor; prueba a ver y nos avisa

validacion_registros_optimizar.rar

validacion_registros_optimizar 2.rar

[flazaroc]

Gracias bigpetroman, muy util la primera solución. Me quedo con esa, nuevamente gracias :encouragement:

Tema Solucionado.

[lina_vcm]

Hola!!! tengo un archivo con una macro function maxcondicional con 2 condiciones pero esta lento, el archivo tiene 50000 datos

Function MAXCONDICIONAL(RANGO1, COND1, RANGO2, COND2, RANGO3 As Range) As Double

MAXIMO = 0

For I = 1 To WorksheetFunction.CountA(RANGO1, RANGO2)

VALOR = RANGO3(I).Value

If RANGO1(I) = COND1 And RANGO2(I) = COND2 And VALOR > MAXIMO Then

MAXIMO = RANGO3(I)

End If

Next

If MAXIMO <= 0 Then MAXIMO = 0

MAXCONDICIONAL = MAXIMO

End Function