Question

我正在使用此宏，尽管运行很慢，但仍可以正常工作。有没有一种方法可以加快它的速度（也许使用数组），以便整个操作只执行一次？

我的代码要做的是，它过滤Excel表格，然后仅提取某些列，然后将它们粘贴到另一张工作表中（按不同顺序）。

Set lo_b1 = x_bf1.ListObjects(1)
s_date = CLng(ThisWorkbook.Names("in_fre_m").RefersToRange(1, 1))
s_des = ThisWorkbook.Names("dr_no").RefersToRange(1, 1)
s_code = ThisWorkbook.Names("dr_co").RefersToRange(1, 1)
lastrow_d = lo_dr.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set pasterange1 = x_drill.Range("C" & lastrow_d)

    With lo_b1.Range
    .AutoFilter Field:=13, Criteria1:=s_code
    .AutoFilter Field:=1, Criteria1:="<=" & s_date
    End With

lastrow_s = lo_b1.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

If lastrow_s > 7 Then
    Set copyrange1 = x_bf1.Range("D8:D" & lastrow_s) 'Date
    Set copyrange2 = copyrange1.Offset(0, 1)  'Description
    Set copyrange3 = copyrange1.Offset(0, 16)  'Calculation
    Set copyrange5 = copyrange1.Offset(0, 5)  'Classification
    Set copyrange6 = copyrange1.Offset(0, 6)  'Notes
    Set copyrange7 = copyrange1.Offset(0, 11) '§
    Set copyrange8 = copyrange1.Offset(0, 12) 'Code
    Set copyrange9 = copyrange1.Offset(0, 20) 'Statutory
    Set copyrange10 = copyrange1.Offset(0, 14) 'Ref


    copyrange10.SpecialCells(xlCellTypeVisible).Copy 'Ref
    pasterange1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange1.SpecialCells(xlCellTypeVisible).Copy 'Date
    pasterange1.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange5.SpecialCells(xlCellTypeVisible).Copy 'Account Name
    pasterange1.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange2.SpecialCells(xlCellTypeVisible).Copy 'Notes
    pasterange1.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange8.SpecialCells(xlCellTypeVisible).Copy 'Code
    pasterange1.Offset(0, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange7.SpecialCells(xlCellTypeVisible).Copy '§
    pasterange1.Offset(0, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange3.SpecialCells(xlCellTypeVisible).Copy 'Calculation
    pasterange1.Offset(0, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange9.SpecialCells(xlCellTypeVisible).Copy 'Statutory
    pasterange1.Offset(0, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    copyrange6.SpecialCells(xlCellTypeVisible).Copy 'Notes
    pasterange1.Offset(0, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

    Set copyrange1 = Nothing
    Set copyrange2 = Nothing
    Set copyrange3 = Nothing
    Set copyrange4 = Nothing
    Set copyrange5 = Nothing
    Set copyrange6 = Nothing
    Set copyrange7 = Nothing
    Set copyrange8 = Nothing
    Set copyrange9 = Nothing
    Set copyrange10 = Nothing
    End If

Answer 1

要添加有关屏幕更新，事件和计算的注释，请尝试更改

copyrange10.SpecialCells(xlCellTypeVisible).Copy 'Ref
pasterange1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

到

pasterange1.Value=copyrange1.SpecialCells(xlCellTypeVisible).Value

根据我的经验，它比复制和粘贴要快得多（它还可以防止使用剪贴板的其他应用程序出现问题）

Excel VBA-加快复制宏

1 个答案: