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
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 SubSaludos.Dante Amor
Recuerda valorar la respuesta.
