☰

向 Excel 表格插入 1000 行

tag-icon • tag-icon microsoft-excel
向 Excel 表格插入 1000 行

我有一张大表，其中大约有 110 个计算列和一行作为模板，用户可以向其中粘贴一定数量的行 - 范围在 30 到 200,000 之间。

我这样做的方法是让他们运行宏，将值粘贴到第一个空单元格。似乎 Excel 会先自动调整表格大小，然后粘贴值。

调整表格大小是最耗时的操作，我正在尝试寻找一种有效的方法来完成它。 为了证实这一理论，我编写了一个宏来插入空白行，但似乎每添加一行，它的速度就会成倍地变慢。此外，在已插入的行上粘贴一组干净的值会非常快（相对于初始粘贴而言）

禁用自动计算并在最后计算所有内容不起作用，调整大小仍然需要很长时间。

有人有什么想法吗？正确的做法是什么。

（由于原因太长，无法在这里解释，PowerPivot 中的计算列不能作为替代方案，并且在 DAX 中为自定义数据透视表重写每个公式在现阶段也不可持续，所以我真的希望找到一个解决方案以便能够继续使用表格）。

提前非常感谢您的帮助！！！

答案1

我偶然发现了有关该问题和解决方案的非常详细的解释：

https://www.thespreadsheetguru.com/blog/fix-slow-pasting-to-excel-tables

此方法的关键在于使用单个命令插入空白行/列，因此插入之间不会发生公式更新。Application.Calculation = xlManual在插入之前禁用 VBA 中的自动重新计算（）可能也会有所帮助，然后在最后重新启用它前启用屏幕更新（Application.Calculation = xlAutomatic）。这不在 SpreadsheetGuru 的代码中，应该添加。

为了完整性，我在此提供电子表格大师的代码。我自己没有测试过此代码。它可能会清除/覆盖表中的旧数据，因此请先备份。所有功劳都归功于 TheSpreadsheetGuru。

Sub ResizeAndPasteToTable()
'PURPOSE: Resize ActiveTable Based on Copied Data and PasteValues Only
'SOURCE: www.TheSpreadsheetGuru.com

Dim myClipboard As Object
Dim ActiveTable As ListObject
Dim TableSize As Range
Dim TableName As String
Dim ClipboardData As String
Dim RowCount As Long
Dim ColumnCount As Long
Dim TableRows As Long
Dim TableColumns As Long
Dim RowDifference As Long
Dim ColumnDifference As Long
Dim UserAnswer As Long
Dim HeaderAdjuster As Integer
Dim x As Integer

'Ensure Data is copied
  If Application.CutCopyMode <> xlCopy And Application.CutCopyMode <> xlCut Then
    MsgBox "Please copy data to the clipboard before running this."
    Exit Sub
  End If

'Determine if ActiveCell is inside a Table
  On Error GoTo NoTableSelected
    TableName = ActiveCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(TableName)
  On Error GoTo 0

'Ask User if they Copied Table Headings
  UserAnswer = MsgBox("Does your copied data include table headings?", vbYesNoCancel)

  Select Case UserAnswer
    Case vbYes: HeaderAdjuster = 0
    Case vbNo: HeaderAdjuster = 1
    Case vbCancel: Exit Sub
  End Select

'Turn Off ScreenUpdating
  Application.ScreenUpdating = False

'Create Data Object using MS Forms 2.0 Object Library (Late Binding)
  Set myClipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

'Gather how many rows/columns to resize Table (based on Copied Range)
  myClipboard.GetFromClipboard
  ClipboardData = myClipboard.GetText
  
  RowCount = UBound(Split(ClipboardData, vbCrLf))
  ColumnCount = UBound(Split(Split(ClipboardData, vbCrLf)(0), vbTab)) + 1
  If RowCount = 0 Then Exit Sub

'Determine difference between copied data and table row count
  TableRows = ActiveTable.DataBodyRange.Rows.Count
  TableColumns = ActiveTable.DataBodyRange.Columns.Count
  RowDifference = RowCount - TableRows
  ColumnDifference = ColumnCount - TableColumns

'Resize ActiveTable Rows (If Necessary)
  If RowDifference > 0 Then
    'Store desired new size to a Range Variable
      Set TableSize = Range(ActiveTable.Name & "[#All]"). _
        Resize(RowCount + HeaderAdjuster, TableColumns)
    
    'Resize Table
      ActiveTable.Resize TableSize
  End If

'Resize ActiveTable Rows (If Necessary)
  If ColumnDifference > 0 Then
    'Store desired new size to a Range Variable
      Set TableSize = Range(ActiveTable.Name & "[#All]"). _
        Resize(ActiveTable.Range.Rows.Count, ColumnCount)
    
    'Resize Table
      ActiveTable.Resize TableSize
  End If

'Paste Data into Table (Values Only)
  If UserAnswer = vbYes Then
    ActiveTable.Range.Cells(1, 1).PasteSpecial xlPasteValues
  Else
    ActiveTable.DataBodyRange.Cells(1, 1).PasteSpecial xlPasteValues
  End If

'Reduce Table Row Count (if necessary)
  If RowDifference < 0 Then
    TableRows = ActiveTable.DataBodyRange.Rows.Count
    ActiveTable.DataBodyRange.Rows(TableRows + HeaderAdjuster + RowDifference & ":" & TableRows).Delete
  End If

'Reduce Table Column Count (if necessary)
  If ColumnDifference < 0 Then
    TableColumns = ActiveTable.DataBodyRange.Columns.Count
    For x = 1 To -ColumnDifference
      ActiveTable.Range.Columns(TableColumns + ColumnDifference + 1).Delete
    Next x
  End If

'Clear Clipboard
  Application.CutCopyMode = msoFalse
  Exit Sub


'ERROR HANDLERS
NoTableSelected:
  MsgBox "There is no Table currently selected!", vbCritical

End Sub

相关内容