Как правильно использовать цикл с автофильтром в моем коде?

Question

Я новичок в VBA.Я пишу макрос, который использует автофильтр, скопировать столбец с результатами на другой лист и удалить дубликаты.Я делаю это для 9 складов х 3 товарной группы = 27 раз.Теперь я скопировал код 27 раз, как показано ниже, и он работает (но очень медленно).Я знаю, я должен использовать цикл, но я не уверен, как это сделать.

склад: "XXX"

Sheets("Apex").Activate
    Lastrow = Range("A1").CurrentRegion.Rows.Count
        Range("A1:J" & Lastrow).Select
            Selection.AutoFilter Field:=6, Criteria1:="NIO"
                Selection.AutoFilter Field:=8, Criteria1:="XXX"
                    Range("A2:A" & Lastrow).Copy
                    Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues
                    Selection.AutoFilter
                            Sheets("Sheet2").Activate
ActiveSheet.Range("$A$1:$A$500").RemoveDuplicates Columns:=1, Header:=xlNo

Спасибо за помощь:)

Answer 1

Я думаю, вы должны дать более подробную информацию о вашей проблеме. Прежде всего, я не вижу индекс столбца группы товаров, но я стараюсь ответить на ваш вопрос как можно больше.

Что я понимаю из вашей проблемы, так это то, что вы слишком часто используете автофильтр, который запускает вычисление рабочей книги каждый раз, когда вы запускаете код, и если у вас есть большие формулы, такие как формулы массива, это действительно может замедлить ваш файл.

Лучшее решение - использовать массивы, но я не могу сообщить подробности, которыми вы делитесь, поэтому я пишу цикл для ваших требований.

Пожалуйста, добавьте новую таблицу в ваш файл с именем Warehouses и запишите названия ваших складов в столбцы A один за другим, скопируйте приведенный ниже код в модуль и запустите его

Sub LoopWareHouses

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Set ws = ThisWorkbook.Sheets("Apex")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set ws3 = ThisWorkbook.Sheets("Warehouses")

Lastrow = ws.Range("A1").CurrentRegion.Rows.Count
lrwarehouses = ws3.Cells(Rows.Count, 1).End(xlUp).Row

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

y = 2
For i = 1 To lrwarehouses
    For j = 2 To Lastrow
        If ws.Cells(j, 6) = "NIO" Then
            If ws.Cells(j, 8) = ws3.Cells(i, 1) Then
                ws2.Cells(y, 1) = ws.Cells(j, 1)
                y = y + 1
            End If
        End If
    Next
Next

lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

Application.Calculate
Do Until Application.CalculationState <> xlDone
    DoEvents
Loop

ws2.Range("A1:A" & lr2).RemoveDuplicates Columns:=1, Header:=xlNo

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub