Блог

У меня есть рабочая книга с двумя листами.
Первый называется «Форма»
, второй называется «Цены»

Я захожу в Forma, с помощью некоторых форм VBA я выбираю категорию продукта. Я помечаю название этой категории в ячейке A1 цен листа, а затем фильтрую товары в соответствии с этой категорией, а затем снова копирую отфильтрованные в форме.

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

Это часть моего кода:

 With ActiveSheet
    range("j7: m30").ClearContents
End With

'Tag the category in Prices Table
ThisWorkbook.Sheets("Prices").Cells(1, 1).Value = "CategoryName.ex.Computers"

'Filtering and selecting products comparing A1 with Column 3 Categories
Worksheets("Prices").Activate

range("A1:K300").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=range("a1").Value

'Copy filtered in Forma Sheet
Dim DbExtract, DuplicateRecords As Worksheet
Set DbExtract = ThisWorkbook.Sheets("Prices")
Set DuplicateRecords = ThisWorkbook.Sheets("Forma")

DbExtract.range("D3:f5000").SpecialCells(xlCellTypeVisible).Copy
DuplicateRecords.Cells(7, 10).PasteSpecial
  

Копирование отфильтрованного диапазона

• Нет activating и не selecting повысит производительность.

• При выключении Application.ScreenUpdating экран перестанет «мигать».

• Использование переменных повысит удобочитаемость.

• Что-то вроде следующего кода может направить вас на правильный путь.

Код

 Option Explicit

Sub copyCategory()
    
    Const Criteria As String = "CategoryName.ex.Computers"
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim src As Worksheet
    Set src = wb.Worksheets("Prices")
    
    Application.ScreenUpdating = False
    
    If src.AutoFilterMode Then
        src.AutoFilterMode = False
    End If
    
    src.Range("A1").Value = Criteria
    src.Range("A1:K300").AutoFilter Field:=3, _
                                    Criteria1:=Criteria
    
    Dim dst As Worksheet
    Set dst = wb.Worksheets("Forma")
    
    dst.Range("J7: M30").ClearContents
    
    src.Range("D3:F300").SpecialCells(xlCellTypeVisible).Copy dst.Range("J7")
    ' If you need some special pasting then rather use the following 3 lines.
    'src.Range("D3:F300").SpecialCells(xlCellTypeVisible).Copy
    'dst.Range("J7").PasteSpecial
    'Application.CutCopyMode = False

    Application.ScreenUpdating = True

    MsgBox "Data copied.", vbInformation, "Success"

End Sub