Cells.SpecialCells（xlCellTypeVisible）。循环慢速复制

Question

I have been asked to create a macro the filters an Excel worksheet on one row, creates a new workbook, and copies the filtered rows along with the header and formulas to the new workbook. I have created a macro that first reads the target row and generates an array contains the unique values. It then loops through the unique values. Within the loop a new workbook is created. The source worksheet is filtered using auto filter for the unique value. The matching rows along with the headers are copied to the new workbook. The new workbook is saved. The first time the loop executes in less than one second. The second time and subsequent times it hangs up on the line:

oSheet.Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=oSplitSheet.Range("A1")

It takes almost a minute for this line to execute. I have tried: application.copyandpaste = false, sheet.empty cell.copy, and a Win32 API call to empty the clopboard all to no effect. The test source worksheet is 91 columns wide, 285 rows long, contains a 2 row header, and the filtered column is column B. I have included a copy of the loop below. Any suggestions would be helpful.

'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 onward, number of cells increased drastically. So your code will run much faster in Excel-2003. Reason for slowness is that everywhere in your code you are referring all the cells in the worksheet.

Such as

Change oSheet.AutoFilterMode to oSheet.UsedRange.AutoFilterMode Change oSheet.Cells.SpecialCells(xlCellTypeVisible) to oSheet.UsedRange.SpecialCells(xlCellTypeVisible)

Review your code and anywhere if you are referring all the cells just confine it to the exact range that you need. Mostly, usedrange will take care of that. And this will increase your code speed

Answer 2

I have found an answer of sorts. It seems that Microsoft has changed the events surrounding the use of the clipboard which account for the slow performance. In other words the code is running as designed. Please refer the these two references for details: 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