Question

将工作表（~300K Cells）从只读模式的源工作簿复制到Thisworkbook后，Workbook.Close False函数会延迟 1分钟

我添加了一个函数，每个循环可以复制几批约50K个单元格，但在特定情况下我不使用剪贴板（对于Formulas）。

我已经在代码的几个点完全清理了剪贴板。

但关闭 源工作簿时，代码似乎仍有一些延迟问题。我在这里复制了创建问题的代码摘要：

' Source: http://www.cpearson.com/excel/Clipboard.aspx
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Private Sub ClearClipboard()
 OpenClipboard (0&)
 EmptyClipboard
 CloseClipboard
End Sub

' Function with part of the code, to reflect the idea
Public Sub Main()
 Set wbSource = Application.Workbooks.Open(strFile, ReadOnly:=True)
 set wsSource = wbSource.WorkSheets("some worksheet")
 Set rnSource = wsSource.UsedRange
 Set rnSource = wsSource.Range("A1", rnSource.rows(rnSource.rows.Count).Columns(rnSource.Columns.Count).Address(False, False))

 Set wsDest = Thisworkbook.Sheets.Add(After:=Thisworkbook.Worksheets(Thisworkbook.Sheets.Count))
 rnDest.Name = rnSource.Name
 Set rnDest = wsDest.Range(rnSource.Address(False, False))

 rnSource.Copy: rnDest.Activate
 rnDest.PasteSpecial xlPasteValuesAndNumberFormats

 'rnDest.Formula = rnSource.Formula ' for big datasets, better to launch batches of 16K cells
 rngBatchCopyFormulas rnSource, rnDest ' for big datasets, better to launch batches of 16K cells
 rnDest.PasteSpecial xlPasteColumnWidths
 rnDest.PasteSpecial xlPasteFormats ' (borders, colors, etc)
 rnDest.PasteSpecial xlPasteComments
 rnDest.PasteSpecial xlPasteValidation
 wsCopyButtons wsSource, wsDest

 ClearClipboard ' this does not seem to solve the delay when closing
 wbSource.Close False ' 1 minute to complete this action
End Sub

还有其他想法吗？

编辑：

我认为这与内存使用有关...我已经使用以下函数批量处理了所有复制粘贴，但仍然在源工作簿的close上出现延迟问题：

Public Function rngBatchCopy(rnSource As Range, rnDest As Range, Optional maxTaskCells As Long = 50000, _
    Optional rngLibConf As RangeLibConf = Nothing) As Boolean
Dim rnSCurr As Range, rnDCurr As Range
Dim rnSRow As Range, rnDRow As Range
Dim lngTotalCells As Long, lngRows As Long, lngColumns As Long
Dim lngLoops As Long, lngRowsLoop As Long, lngRowsCurrLoop As Long
Dim lngCurrRow As Long, lngRestRows As Long

 On Error GoTo rngBatchCopyErr
 rngBatchCopy = False

 If (rnSource Is Nothing) Or (rnDest Is Nothing) Then Exit Function
 If rngLibConf Is Nothing Then Set rngLibConf = New RangeLibConf

 lngColumns = rnSource.Columns.Count: lngRows = rnSource.rows.Count
 lngTotalCells = lngColumns * lngRows 'rnsource.Cells.Count
 lngLoops = Round(lngTotalCells / maxTaskCells) - 1
 lngRowsLoop = IIf(maxTaskCells <= lngColumns, 1, Int(maxTaskCells / lngColumns))

 lngCurrRow = 1: lngRestRows = lngRows
 Do While (lngCurrRow <= lngRows) 'And (lngRestRows > 0)
    lngRowsCurrLoop = IIf(lngRowsLoop < lngRestRows, lngRowsLoop, lngRestRows)
    Set rnSRow = rnSource.rows(lngCurrRow)
    Set rnSCurr = rnSRow.Resize(lngRowsCurrLoop)
    Set rnDRow = rnDest.rows(lngCurrRow)
    Set rnDCurr = rnDRow.Resize(lngRowsCurrLoop)
    lngRestRows = lngRestRows - lngRowsCurrLoop: lngCurrRow = lngCurrRow + lngRowsCurrLoop

    rnSCurr.Copy
    With rngLibConf
        rnDCurr.PasteSpecial xlPasteValuesAndNumberFormats  ' to avoid Err: "To do this, all the merged cells need to be the same size."
        'If .CopyFormulas Then rnDest.Formula = rnSource.Formula ' for big datasets, better to launch batches of 16K rows
        Application.CutCopyMode = False: Application.CutCopyMode = True
        rnSource.Copy
        If .CopyFormulas Then
            'rnSCurr.Copy: rnDCurr.PasteSpecial xlPasteFormulas
            rnDCurr.Formula = rnSCurr.Formula
            Application.CutCopyMode = False: Application.CutCopyMode = True
            rnSCurr.Copy
        End If
        If .CopyFormats Then
            rnDCurr.PasteSpecial xlPasteColumnWidths
            rnDCurr.PasteSpecial xlPasteFormats ' (borders, colors, etc)
            Application.CutCopyMode = False: Application.CutCopyMode = True
            rnSCurr.Copy
        End If
        If .CopyComments Then
            rnDCurr.PasteSpecial xlPasteComments
            Application.CutCopyMode = False: Application.CutCopyMode = True
            rnSCurr.Copy
        End If
        If .CopyValidation Then
            rnDCurr.PasteSpecial xlPasteValidation
            Application.CutCopyMode = False: Application.CutCopyMode = True
            rnSCurr.Copy
        End If
        Application.CutCopyMode = False: Application.CutCopyMode = True
        ClearClipboard
    End With
 Loop
 rngBatchCopy = True
rngBatchCopyErr:
 'Application.CutCopyMode = False ' It cleans the clipboard partially
 ClearClipboard
End Function

与wbSource相关的垃圾收集器？

修改：

只有当源工作表/范围包含公式时才会发生...任何想法？

VBA非常慢关闭只读工作簿（复制工作表后）

0 个答案: