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