Criei um código VBA, onde o objetivo é consultar uma tabela e comparar se todos os itens cadastrados em uma determinada caixa estão com os status "descartar", em caso positivo, ele deve adicionar o número desta caixa em uma tabela de descarte e outra aba da planilha. Porém ele está muito lento demorando horas para acabar de rodar o código, tentei revisar ele de todas as formas que conheço para deixa-lo o mais enxuto possível. Segue abaixo foto da tabela que ele consulta: Tabela que o código consulta
Código criado para fazer a consulta e montar tabela de descarte:
Sub Consultar_caixas_para_descartar()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
tempoinicial = Timer
Dim last As Integer
Dim x As Integer
Dim listaS As New Collection
Dim listaN As New Collection
Dim descarta As Boolean
last = Sheets("Cadastro de amostras").Range("A40000").End(xlUp).Row
For f = 3 To last
If Sheets("Cadastro de amostras").Range("F" & f).Text = "Descartar" Then
For Each Item In listaS
If Item = Sheets("Cadastro de amostras").Range("B" & f).Text Then GoTo nextfor
Next Item
For Each Item In listaN
If Item = Sheets("Cadastro de amostras").Range("B" & f).Text Then GoTo nextfor
Next Item
descarta = True
For J = f + 1 To last
If Sheets("Cadastro de amostras").Range("B" & J) = Sheets("Cadastro de amostras").Range("B" & f) And Range("F" & J).Text <> "Descartar" Then descarta = False
Next
If descarta = True Then listaS.Add Sheets("Cadastro de amostras").Range("B" & f).Text
Else
listaN.Add Sheets("Cadastro de amostras").Range("B" & f).Text
End If
nextfor:
Next
Sheets("Caixas para descartar").Cells.Delete Shift:=xlUp
Sheets("Caixas para descartar").Range("A1") = "Caixas para Descartar"
x = 2
For Each Item In listaS
Range("A" & x) = Item
x = x + 1
Next Item
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Tabela1"
Columns("A").EntireColumn.AutoFit
Range("A1").Select
MsgBox (Timer - tempoinicial)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
for
dentro dofor
maior? Os dois primeiros, que iteramlistaS
elistaN
, me parecem ser para evitar duplicatas nestas listas, e o terceiro, que itera as linhas posteriores à atual, me parece ser para prevenir conflitos em que a mesma caixa aparece em duas linhas, mas marcada para descartar em uma e para manter na outra. Entendi certo?