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

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

1 个答案: