Cells.SpecialCells(xlCellTypeVisible).Copy循环缓慢

我被要求在一行上创build一个macrosExcel的工作表的filter,创build一个新的工作簿,并将过滤的行与标题和公式复制到新的工作簿。 我已经创build了一个macros,它首先读取目标行并生成一个包含唯一值的数组。 然后通过独特的值循环。 在循环中创build一个新的工作簿。 源工作表使用自动筛选器筛选唯一值。 匹配的行以及标题将被复制到新的工作簿。 新的工作簿被保存。 循环第一次在不到一秒的时间内执行。 第二次和随后的时间,它挂断线:

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

这条线执行需要几分钟的时间。 我已经尝试过:application.copyandpaste = false,sheet.empty cell.copy和一个Win32 API调用来清空电路板都不起作用。 testing源工作表是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 

Excel-2007以后,单元数急剧增加。 所以你的代码将在Excel-2003中运行得更快。 缓慢的原因是在代码中的任何地方都指向工作表中的所有单元格。

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

如果你指的是所有的单元,只要将它们限制在你需要的确切范围内,就可以查看你的代码。 大多数情况下,usedrange会照顾到这一点。 这会提高你的代码速度

我find了一个答案。 看来,微软已经改变了围绕使用剪贴板的事件,这是缓慢的性能的原因。 换句话说,代码按devise运行。 有关详细信息,请参阅这两个参考: 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