Блог

Главная - Вопросы по программированию - Как быстро копировать и вставлять из отфильтрованного диапазона

Как быстро копировать и вставлять из отфильтрованного диапазона

#excel #vba #performance

#excel #vba #Производительность

Вопрос:

Это повторяется не менее 100 раз (более 100 моделей), и в настоящее время это занимает почти 15 минут. Как я могу ускорить копирование из видимых отфильтрованных ячеек и вставку, чтобы сократить время до секунд? data это еще одна книга.

         Dim last_row As Long
        last_row = ThisWorkbook.Worksheets("Enter models").Range("B" amp; Rows.Count).End(xlUp).Row
        Dim models() As Variant
        models = ThisWorkbook.Worksheets("Enter models").Range("B2:B" amp; last_row).Value
        With data
            Dim last_row_src As Long
            last_row_src = .Range("A" amp; .Rows.Count).End(xlUp).Row
            Dim model As Variant
            Dim last_row_dest As Long
            Dim start_time As Date
            start_time = Now()
            Dim end_time As Date
            For Each model In models
                .Range("$A$3:$BP$3").AutoFilter Field:=20, Criteria1:=model
                last_row_dest = ThisWorkbook.Worksheets("PO Tracker").Range("A" amp; Rows.Count).End(xlUp).Row   1
                'appends to last empty row in PO Tracker worksheet
                'product ID
                On Error Resume Next
                .Range("T4:T" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("A" amp; last_row_dest).PasteSpecial xlPasteValues
                'PO
                On Error Resume Next
                .Range("W4:W" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("B" amp; last_row_dest).PasteSpecial xlPasteValues
                'SAP status
                On Error Resume Next
                Set src_range = .Range("BJ4:BJ" amp; last_row_src).SpecialCells(xlCellTypeVisible)
                ThisWorkbook.Sheets("PO Tracker").Range("C" amp; last_row_dest).PasteSpecial xlPasteValues
                'delivery number
                On Error Resume Next
                .Range("X4:X" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("D" amp; last_row_dest).PasteSpecial xlPasteValues
                'order quantity
                On Error Resume Next
                .Range("F4:F" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("I" amp; last_row_dest).PasteSpecial xlPasteValues
                'expected delivery date
                On Error Resume Next
                .Range("I4:I" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("M" amp; last_row_dest).PasteSpecial xlPasteValues
                'expected GI date
                On Error Resume Next
                .Range("J4:J" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
                ThisWorkbook.Sheets("PO Tracker").Range("N" amp; last_row_dest).PasteSpecial xlPasteValues
                .ShowAllData
            Next
            end_time = Now()
            Debug.Print end_time - start_time
         End With

Комментарии:

1. Почему вы пытаетесь фильтровать несколько раз и копировать каждый диапазон фильтров, когда вы могли бы использовать Sort на основе Column B значений, а затем скопировать весь диапазон за один раз? Или еще лучше использовать advanced filter sort , а затем скопировать / вставить

2. @gmalc хорошее предложение. Я не знал о расширенной сортировке фильтров. Не могли бы вы опубликовать его в качестве ответа с некоторым кодом, чтобы я попробовал его, а затем отметил, что он решен.

3. Для вас было бы лучше, если бы вы выполнили поиск, а затем попытались выполнить Filter Sort , и если у вас возникнут какие-либо проблемы, задайте другой вопрос.

Ответ №1:

По предложению GMalc я использовал AdvancedFilter сокращение с 15 минут до 2 минут, поскольку мне больше не нужно выполнять цикл.

      With data
            Dim last_row_src As Long
            last_row_src = .Range("A" amp; .Rows.Count).End(xlUp).Row
            Dim model As Variant
            Dim last_row_dest As Long
            Dim start_time As Date
            start_time = Now()
            Dim end_time As Date
            Dim last_row_models As Long
            last_row_models = ThisWorkbook.Worksheets("Enter models").Range("B" amp; Rows.Count).End(xlUp).Row
            .Range("T3").Value2 = "Item"
            .Range("A3:BP" amp; last_row_src).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ThisWorkbook.Worksheets("Enter models").Range("B1:B" amp; last_row_models)
        'product ID
        On Error Resume Next
        .Range("T4:T" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("A2").PasteSpecial xlPasteValues
        'PO
        .Range("W4:W" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("B2").PasteSpecial xlPasteValues
        'SAP status
        .Range("BJ4:BJ" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("C2").PasteSpecial xlPasteValues
        'delivery number
        .Range("X4:X" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("D2").PasteSpecial xlPasteValues
        'order quantity
        .Range("F4:F" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("I2").PasteSpecial xlPasteValues
        'expected delivery date
        .Range("I4:I" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("M2").PasteSpecial xlPasteValues
        'expected GI date
        .Range("J4:J" amp; last_row_src).SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Sheets("PO Tracker").Range("N2").PasteSpecial xlPasteValues
        .ShowAllData
        end_time = Now()
        Debug.Print end_time - start_time
   End With