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

Recorrer Columna y copiar los datos

Estoy queriendo hacer un código VB para excel donde me recorra la Columna M de una hoja que especificar con inputbox Inicia en M6 y termina en variable quiero decir va creciendo las filas el dato que quiero buscar es "disponible" y que si es me copie...
1 respuesta

¿Cómo combino dos macros que hacen lo que necesito?

Tengo que aplicar dos macros a muchos archivos en excel, Pero es laborioso estar haciendo manualmente algunos procesos para las macros. ¿Cómo fusiono estas dos macros? ¿Se requiere de hacer una nueva macro? Me refiero a las macros de las dos...
1 respuesta

Como buscar y/o filtrar en un listbox con ayuda de un texbox

Bueno tengo un listbox que ciertamente me filtra las palabras, pero tengo que insertar la primera letra de la palabra que busco para que se pueda filtrar. Tengo un código para filtrar parte del texto y no es necesario tener que ingresar la primera...
2 respuestas

¿Cómo eliminar repetidos, si estos se repiten más de 3 veces, me deje solo 2 registros?

, espero que me puedan ayudar mi problema es el siguiente: Tengo una base de datos en la cual los registros se repiten mas de 3 veces, necesito que borre los demas registros y solamente me deje 2 de esos registros, siempre y cuando se repita mas de 3...
1 respuesta

Implementar Progress Bar en macro para generar efecto visual

Sub Buscar() 'Mod.Por.DAM Application.ScreenUpdating = False Set h1 = Sheets("Estados de cuenta") Set h2 = Sheets("Cartera.") ' h1.Range("A18:E6000").ClearContents j = 18 Set r = h2.Columns("G") Set b = r.Find(h1.Range("A6"), LookIn:=xlValues,...
1 respuesta