0

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
3
  • Uma dúvida: qual a necessidade dos 3 loops for dentro do for maior? Os dois primeiros, que iteram listaS e listaN, 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? Commented 28/07/2022 às 7:51
  • Se for isso, existem formas bem mais rápidas de fazer, porque para cada item da tabela, você está iterando todos os outros. Commented 28/07/2022 às 7:52
  • Exato César seu entendimento foi correto, pois ao meu entendimento se eu não criasse o código assim, ele iria me trazer número de caixas duplicadas na lista de descarte de amostras ou até mesmo número de caixas que não deveriam estar nela por conta de não ter todos os itens dentro dela com o status "descartar".
    – Nelson
    Commented 2/08/2022 às 16:48

0

Você deve fazer log-in para responder a esta pergunta.

Pesquise outras perguntas com a tag .