Question

我被要求创建一个宏，在一行上过滤Excel工作表，创建一个新工作簿，并将过滤后的行以及标题和公式复制到新工作簿。我创建了一个宏，它首先读取目标行并生成一个包含唯一值的数组。然后循环遍历唯一值。在循环内创建一个新工作簿。使用自动过滤器过滤源工作表以获取唯一值。匹配的行以及标题将复制到新工作簿。新工作簿已保存。循环第一次在不到一秒的时间内执行。第二次以及随后的时间它挂起了线：

oSheet.Cells.SpecialCells（xlCellTypeVisible）。复制目的地：= oSplitSheet.Range（＆＃34; A1＆＃34;）

此行执行需要将近一分钟。我试过：application.copyandpaste = false，sheet.empty cell.copy，以及用于清空clopboard的Win32 API调用都没有效果。测试源工作表宽91列，长285行，包含2行标题，过滤列为B列。我已经在下面提供了一个循环的副本。任何建议都会有所帮助。

'Create the split books
For lngFilterRow = 1 To lngFilterRowMax
    'update the form
    Me.txtCurrent = lngFilterRow
    DoEvents

    'Get the next filter
    strFilter = rayFilter(lngFilterRow)

    'Get the split sheet name
    strSplitName = Me.txtFolder & "\" & strBaseName & "_" & strFilter & ".xlsx"

    'Open the target workbook
    Set oBook = Application.Workbooks.Add
    Set oSplitSheet = oBook.Worksheets(1)

    'Set the cell widths
    For lngCol = lngColFirst To lngColMax
        oSplitSheet.Range(oSplitSheet.Cells(1, lngCol), oSplitSheet.Cells(1, lngCol)).ColumnWidth = rayCol(lngCol).ColumnWidth
    Next

    'Filter the sheet
    oSheet.AutoFilterMode = False
    strCell = "$" & Me.txtSource & "$" & lngHeaderRowMax
    lngFilterCol = oSheet.Range(strCell).Column
    strCell = "$" & Me.txtColumnFirst & "$" & Me.txtHeaderRowLast & ":$" & Me.txtColumnLast & "$" & Me.txtHeaderRowLast
    oSheet.Range(strCell).AutoFilter Field:=lngFilterCol, Criteria1:=strFilter

    'Paste the fitlered sheet
    oSheet.Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=oSplitSheet.Range("A1")

    'Get the Row Count
    strCell = "$" & Me.txtSource & "$" & lngRowFirst
    lngCol = oSplitSheet.Range(strCell).Column
    If IsEmpty(oSplitSheet.Cells(lngRowFirst + 1, lngCol).Value) Then
        lngSplitRowMax = lngRowFirst
    Else
        lngSplitRowMax = oSplitSheet.Range(strCell).End(xlDown).Row
    End If

    'add the formulas and numberformats
    For lngCol = lngColFirst To lngColMax
        Set oRange = oSplitSheet.Range(oSplitSheet.Cells(lngRowFirst, lngCol), oSplitSheet.Cells(lngSplitRowMax, lngCol))
        oRange.NumberFormat = rayCol(lngCol).NumberFormat
        oRange.Interior.Color = rayCol(lngCol).BackColor
        If rayCol(lngCol).HasFornula Then
            Set SourceRange = oSplitSheet.Range(oSplitSheet.Cells(lngRowFirst, lngCol), oSplitSheet.Cells(lngRowFirst, lngCol))
            SourceRange.Formula = rayCol(lngCol).Formula
            If lngSplitRowMax > lngRowFirst Then
                SourceRange.AutoFill Destination:=oRange
            End If
        End If
    Next

    'Save the workbook
    oBook.SaveAs Filename:= _
        strSplitName, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    oBook.Close savechanges:=False

    'Update the progress bar
    txtProgressBarB.Width = (txtProgressBarA.Width / lngFilterRowMax) * lngFilterRow
    DoEvents

    Set oRange = Nothing
    Set SourceRange = Nothing
    Set SplitRange = Nothing
    Set oSplitSheet = Nothing
    Set oBook = Nothing


Next

Answer 1

Excel-2007以后，细胞数量急剧增加。因此，您的代码将在Excel-2003中运行得更快。缓慢的原因是你的代码中的所有单元都指的是工作表中的所有单元格。

如

将oSheet.AutoFilterMode更改为oSheet.UsedRange.AutoFilterMode 将oSheet.Cells.SpecialCells(xlCellTypeVisible)更改为oSheet.UsedRange.SpecialCells(xlCellTypeVisible)

检查您的代码以及任何地方，如果您指的是所有单元格，只需将其限制在您需要的确切范围内。大多数情况下，usedrange将负责这一点。这将提高您的代码速度

Answer 2

我找到了各种答案。似乎微软已经改变了使用剪贴板的事件，这导致了缓慢的性能。换句话说，代码按设计运行。有关详细信息，请参阅这两个参考： https://social.msdn.microsoft.com/Forums/office/en-US/858c1c9d-a347-473d-8c81-829e22b6f592/slow-excel-2010-macro-execution?forum=exceldev

https://social.msdn.microsoft.com/Forums/office/en-US/c15acbd2-abc8-4135-b8af-4598da70c675/specialcells-function-is-very-slow-in-excel-2010?forum=exceldev

Cells.SpecialCells（xlCellTypeVisible）.Copy循环缓慢

2 个答案: