Dante Amor_Optimizar macro-cartera farmacia

Hola experto, por favor revisar y ver si se puede hacer que la macro Cartera Farmacia se ejecute más rápido, la misma trabaja 7 mil filas una por una y quizá se pueda optimizar. Además me gustaría ponerle una Progress Bar. Muchas gracias y un saludo

1 Respuesta

Respuesta
2

Reviso el archivo y te envío una respuesta.

Esta es la macro optimizada, ahora el proceso dura como 15 segundos.

Sub principal()
'Por.DAM
    Application.ScreenUpdating = False
    Set h1 = Sheets("SAP")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    Label1 = "Agregando comentarios ..."
    rep = 10
    DoEvents
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="1B"
    h1.Range("K2:K" & u) = "Notas de Credito"
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:=Array("DA", "DT", "DZ"), Operator:=xlFilterValues
    h1.Range("K2:K" & u) = "Saldo a Favor"
    h1.Range("A1:L" & u).AutoFilter Field:=3, Criteria1:="="
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="YB"
    h1.Range("K2:K" & u) = "Documentos en Transito"
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="YB"
    h1.Range("A1:L" & u).AutoFilter Field:=10, Criteria1:="<=0"
    h1.Range("K2:K" & u) = "En Tiempo"
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:=Array("YB", "YJ", "YS"), Operator:=xlFilterValues
    h1.Range("A1:L" & u).AutoFilter Field:=10, Criteria1:=">0"
    h1.Range("K2:K" & u) = "Vencido"
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h1.Columns("F:F").NumberFormat = "###"
    UpdateProgressBar rep
    rep = rep + 10
    Set h2 = Sheets("Cuentas_SAP")
    Label1 = "Buscando nombres de clientes ..."
    fin = h2.Range("A" & Rows.Count).End(xlUp).Row
    con = 1
    For i = 3 To fin
        h1.Range("A1:L" & u).AutoFilter Field:=6, Criteria1:=h2.Cells(i, "A")
        h1.Range("L2:L" & u) = h2.Cells(i, "B")
        If (con * 100) / fin >= rep Then
            UpdateProgressBar rep
            rep = rep + 10
        End If
        con = con + 1
    Next
    If rep <= 100 Then
        UpdateProgressBar rep
    End If
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = True
    Label1 = "Proceso Terminado."
End Sub

Hola DAM, sucede que creo que la macro no me está identificando bien los criterios, por ejemplo, en el archivo que te pasé deberían aparecer partidas con comentario: "Saldo a Favor","Documentos en Transito", "Notas de Credito" sin embargo la macro que me pasaste solo muestra las partidas con comentarios: "En Tiempo" y "Vencido", osea que los demás criterios no me los está mostrando como debería.

Gracias de antemano ;)

Envíame ese archivo con el que estás probando para revisarlo.

Hohla:

Ya hice la corrección a la macro.

Adicionalmente te comento que el filtro "Documentos en Transito", puede sobreescribirse con los filtros de "En Tiempo" o "Vencido", te explico porqué.

Los documentos en tránsito corresponden a la clase = "YB" y Texto = ""

Ahora, si la clase es "YB" y demora "<=0", entonces si estaba "en tránsito" le va a poner "En tiempo"

Lo mismo, si la clase es "YB" y demora ">0", entonces si estaba en tránsito le va a poner "Vencido".

Ejemplo:

El documento de la fila 15 "7000732689", su Clase es "YB", en Texto tiene vacío y Demora es 4, este documento qué debe ser "en tránsito" o "vencido", ya que este documento cae en las 2 clasificaciones.

Sub principal()
'Por.DAM
    Application.ScreenUpdating = False
    On Error Resume Next
    Set h1 = Sheets("SAP")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    Label1 = "Agregando comentarios ..."
    rep = 10
    DoEvents
    h1.AutoFilterMode = False
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="1B"
    h1.Range("K2:K" & u).SpecialCells(xlCellTypeVisible) = "Notas de Credito"
    h1.AutoFilterMode = False
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:=Array("DA", "DT", "DZ"), Operator:=xlFilterValues
    h1.Range("K2:K" & u).SpecialCells(xlCellTypeVisible) = "Saldo a Favor"
    h1.AutoFilterMode = False
    h1.Range("A1:L" & u).AutoFilter Field:=3, Criteria1:="="
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="YB"
    h1.Range("K2:K" & u).SpecialCells(xlCellTypeVisible) = "Documentos en Transito"
    h1.AutoFilterMode = False
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:="YB"
    h1.Range("A1:L" & u).AutoFilter Field:=10, Criteria1:="<=0", Operator:=xlAnd
    h1.Range("K2:K" & u).SpecialCells(xlCellTypeVisible) = "En Tiempo"
    h1.AutoFilterMode = False
    h1.Range("A1:L" & u).AutoFilter Field:=5, Criteria1:=Array("YB", "YJ", "YS"), Operator:=xlFilterValues
    h1.Range("A1:L" & u).AutoFilter Field:=10, Criteria1:=">0"
    h1.Range("K2:K" & u).SpecialCells(xlCellTypeVisible) = "Vencido"
    h1.AutoFilterMode = False
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h1.Columns("F:F").NumberFormat = "###"
    UpdateProgressBar rep
    rep = rep + 10
    Set h2 = Sheets("Cuentas_SAP")
    Label1 = "Buscando nombres de clientes ..."
    fin = h2.Range("A" & Rows.Count).End(xlUp).Row
    con = 1
    For i = 3 To fin
        h1.AutoFilterMode = False
        h1.Range("A1:L" & u).AutoFilter Field:=6, Criteria1:=h2.Cells(i, "A")
        h1.Range("L2:L" & u).SpecialCells(xlCellTypeVisible) = h2.Cells(i, "B")
        If (con * 100) / fin >= rep Then
            UpdateProgressBar rep
            rep = rep + 10
        End If
        con = con + 1
    Next
    If rep <= 100 Then
        UpdateProgressBar rep
    End If
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = True
    Label1 = "Proceso Terminado."
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas