Excel中的VBA代码非常慢（复制130个单元需要15秒）

在Excel VBA中我有两个表。 我从第一个二复制细胞。 表的结构是不同的，所以我复制逐个单元格。 只有130个单元被复制，仍然需要大约15秒。 我怎样才能加快速度？

看来，如果我从VBA编辑器运行macros，速度更快，但仍然需要至less10秒。 如果我从Excel中运行它，那么我可以看到select和单元格的复制。 所以它很慢。

我应该尝试在单元格而不是副本之间分配值吗？ 还是VBA只是慢？

Public Sub PasteValueRowsIntoAccountDateTable() Dim rowNumberOfTarget As Integer Dim rowNumberOfSource As Integer Sheets("Utolsó hó").Select Dim myTable As Excel.ListObject Dim myRow As Excel.ListRow Set myTable = ActiveSheet.ListObjects("Utolsó_hó") For Each myRow In myTable.ListRows rowNumberOfSource = myRow.Range.row Sheets("Számla dátum").Select rowNumberOfTarget = Range("Számla_dátum[[#Totals],[Előző Id]]").Value2 + 1 Rows(rowNumberOfTarget & ":" & rowNumberOfTarget).Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Call PasteValueRowIntoAccountDateTable(rowNumberOfSource, rowNumberOfTarget) Next myRow End Sub Public Sub PasteValueRowIntoAccountDateTable(ByVal rowNumberOfSource As Integer, ByVal rowNumberOfTarget As Integer) Call FillDownInAccountDateTable("Előző Id", rowNumberOfTarget) Call FillDownInAccountDateTable("Havi nettó hozam", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Számlanév", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Aktuális dátum", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Nettó számla érték", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Nettó nem realizált hozam", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Havi nettó realizált hozam", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Havi tranzfer saját számlák között", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Havi jövedelem", rowNumberOfTarget) Call PasteValueCellIntoAccountDateTable(rowNumberOfSource, "Havi költés", rowNumberOfTarget) End Sub Public Sub FillDownInAccountDateTable(ByVal columnName As String, ByVal rowNumberOfTarget As Integer) Dim columnNumberOfTarget As Integer columnNumberOfTarget = TableColumnToIndex("Számla dátum", "Számla_dátum[" & columnName & "]") Sheets("Számla dátum").Select Cells(rowNumberOfTarget, columnNumberOfTarget).Select Selection.FillDown End Sub Public Sub PasteValueCellIntoAccountDateTable(ByVal rowNumberOfSource As Integer, ByVal columnName As String, ByVal rowNumberOfTarget As Integer) Dim columnNumberOfTarget As Integer Dim columnNumberOfSource As Integer columnNumberOfSource = TableColumnToIndex("Utolsó hó", "Utolsó_hó[" & columnName & "]") Sheets("Utolsó hó").Select Cells(rowNumberOfSource, columnNumberOfSource).Copy columnNumberOfTarget = TableColumnToIndex("Számla dátum", "Számla_dátum[" & columnName & "]") Sheets("Számla dátum").Select Cells(rowNumberOfTarget, columnNumberOfTarget).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End Sub 

Answer 1

您需要更改表名称。 我的Excel版本不允许在表名称中使用重音符号。

 Public Sub PasteValueRowsIntoAccountDateTable2() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim SourceTable As Excel.ListObject, TargetTable As Excel.ListObject Dim TargetRow As Integer Dim ColumnHeaders, ch ColumnHeaders = Array("Számlanév", "Aktuális dátum", "Nettó számla érték", "Nettó nem realizált hozam", "Havi nettó realizált hozam", "Havi tranzfer saját számlák között", "Havi jövedelem", "Havi költés") Set SourceTable = Worksheets("Sheet1").ListObjects("Table2") Set TargetTable = Worksheets("Sheet2").ListObjects("Table3") TargetRow = TargetTable.ListRows.Add.Range.Row - 1 For Each ch In ColumnHeaders SourceTable.ListColumns(ch).DataBodyRange.Copy TargetTable.ListColumns(ch).DataBodyRange.Cells(TargetRow) Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

更快的是我们一个数组一次传输所有的数据。

 Sub TransferRowsByArray() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim SourceTable As Excel.ListObject, TargetTable As Excel.ListObject Dim col As Integer, x As Long Dim ColumnHeaders, ch, Data ColumnHeaders = Array("Számlanév", "Aktuális dátum", "Nettó számla érték", "Nettó nem realizált hozam", "Havi nettó realizált hozam", "Havi tranzfer saját számlák között", "Havi jövedelem", "Havi költés") Set SourceTable = Worksheets("Sheet1").ListObjects("Table1") Set TargetTable = Worksheets("Sheet2").ListObjects("Table2") ReDim Data(1 To SourceTable.DataBodyRange.Rows.Count, 1 To SourceTable.DataBodyRange.Columns.Count) For Each ch In ColumnHeaders col = TargetTable.ListColumns(ch).Index With SourceTable.ListColumns(ch).DataBodyRange For x = 1 To .Rows.Count Data(x, col) = .Cells(x).Formula Next End With Next With TargetTable.ListRows.Add .Range.Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub