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

Question

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

看来，如果我从VBA编辑器运行宏，它更快，但仍需要至少10秒。如果我从Excel中运行它，那么我可以看到选择和复制单元格。所以它很慢。

我应该尝试在单元之间分配值而不是复制吗？或者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